home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / POPC.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1996-01-25  |  86.7 KB  |  2,227 lines  |  [TEXT/.Ob4]
  1. Syntax10b.Scn.Fnt
  2. Syntax10.Scn.Fnt
  3. Syntax10i.Scn.Fnt
  4. InfoElems
  5. Alloc
  6. Syntax10.Scn.Fnt
  7. StampElems
  8. Alloc
  9. 25 Jan 96
  10. "Title": 
  11. "Author": 
  12. "Abstract": 
  13. "Keywords": 
  14. "Version": 
  15. "From":  04.07.95 13:54:44
  16. "Until": 
  17. "Changes": 
  18. mah/mk    4.7.95    NIL checks on less equal zero removed because of supposed 
  19.                             negative pointer values from Printer.SetPort
  20. mah    14.8.95    Store Condition modified to correct buf with BOOL expressions
  21.                         cf:=FALSE;  c:=TRUE; cf:=c OR cf; ->  endless loop
  22. Syntax12b.Scn.Fnt
  23. Syntax12.Scn.Fnt
  24. FoldElems
  25. Syntax10.Scn.Fnt
  26. Syntax10b.Scn.Fnt
  27.     PROCEDURE MskAsh* (VAR x, y, z: OPL.Item; rt: LONGINT);
  28.     BEGIN
  29.         ASSERT(y.mode = Con);
  30.         Msk(x, y, -1); Ash(x, z, rt)
  31.     END MskAsh;
  32.     PROCEDURE AshMsk* (VAR x, y, z: OPL.Item; rt: LONGINT);
  33.         VAR sh, mb: LONGINT;
  34.     BEGIN
  35.         ASSERT(z.mode = Con);
  36.         IF y.mode = Con THEN mb := CNTLZ(-1-z.offset); sh := y.offset;
  37.             IF sh > 0 THEN
  38.                 IF mb+sh < 24 THEN MakeReg(x, -1) END;
  39.                 OPL.FreeTempR(x.reg); rt := CheckR(rt); OPL.Put(iRLINM+rt*fRA+x.reg*fRS+sh*fSH+mb*fMB+(31-sh)*fME); x.reg := rt
  40.             ELSIF SYSTEM.VAL(SET, ASH(80000000H, sh)) * SYSTEM.VAL(SET, -1-z.offset) = {} THEN
  41.                 IF mb < 24 THEN MakeReg(x, -1) END;
  42.                 OPL.FreeTempR(x.reg); rt := CheckR(rt); OPL.Put(iRLINM+rt*fRA+x.reg*fRS+(sh MOD 32)*fSH+mb*fMB+31*fME); x.reg := rt
  43.             ELSE
  44.                 Ash(x, y, -1); Msk(x, z, rt)
  45.             END
  46.         ELSE
  47.             Ash(x, y, -1); Msk(x, z, rt)
  48.         END
  49.     END AshMsk;
  50. Syntax10.Scn.Fnt
  51.                     t1 := OPL.GetTempR(); OPL.Put(iCAL+t1*fRT+4); OPL.Put(iMTSPR+t1*fRS+spXER*fSPR);
  52.                     LoadAddr(x, -1); LoadAddr(y, -1); OPL.Put(iCAL);
  53.                     s1 := x.reg; s2 := y.reg; t2 := OPL.GetTempR(); f := OPL.GetTempCRF();
  54.                     b := OPL.GetCRF0(); IF b # 0 THEN OPM.err(215) END;
  55.                     lstlab := 0; SetLabel(lstlab); OPL.Put(iLSCBX+t1*fRT+s1*fRA+fREC); OPL.Put(iLSCBX+t2*fRT+s2*fRA);
  56.                     lastlab := 0; PutBranchInstr(iBM, lastlab); OPL.Put(iCMPL+f*fBF+t1*fRA+t2*fRB);
  57.                     OPL.Put(iAI+4); endlab := 0; PutBranchInstr(iBF+(f*4+bEQ)*fBI, endlab); PutBranch(lstlab);
  58.                     SetLabel(lastlab); OPL.Put(iMFSPR+spXER*fSPR); OPL.Put(iSFI+4);
  59.                     OPL.Put(iRLINM+3*fSH+28*fME); OPL.Put(iSR+t1*fRS+t1*fRA); OPL.Put(iSR+t2*fRS+t2*fRA);
  60.                     OPL.Put(iCMPL+f*fBF+t1*fRA+t2*fRB); SetLabel(endlab);
  61.                     OPL.FreeTempCRBs({b*4..b*4+3}); OPL.FreeTempR(s1); OPL.FreeTempR(s2);
  62.                     OPL.FreeTempR(t1); OPL.FreeTempR(t2)
  63. MODULE POPC;    (* mmb 4.3.91 / 20.11.94 *)
  64.     IMPORT
  65.         OPL := POPL, OPT := POPT, OPM := POPM, SYSTEM;
  66.     CONST
  67.         (* symbol values and ops *)
  68.         times = 1; slash = 2; div = 3; mod = 4; and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  69.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14; in = 15; is = 16; ash = 17; msk = 18; len = 19;
  70.         conv = 20; abs = 21; cap = 22; odd = 23; not = 32;
  71.         (*SYSTEM*)
  72.         adr = 24; cc = 25; bit = 26; lsh = 27; rot = 28; val = 29;
  73.         (* structure forms *)
  74.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  75.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  76.         Pointer = 13; ProcTyp = 14; Comp = 15;
  77.         (* structure sets *)
  78.         RealTypes = {Real, LReal};
  79.         (* composite structure forms *)
  80.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  81.         (* nodes classes *)
  82.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  83.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  84.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  85.         Nifelse =20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  86.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  87.         (* item/object modes *)
  88.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7; SProc = 8; CProc = 9; IProc = 10;
  89.         Head = 12; Based = 14; Indexed = 15; Reg = 16; RegSI = 17; FReg = 18; Cond = 19;
  90.         (* compiler options: *)
  91.         inxchk = 0;    (* index check on *)
  92.         ovflchk = 1;    (* overflow check on *)
  93.         ranchk = 2;    (* range check on *)
  94.         typchk = 3;    (* type check on *)
  95.         newsf = 4;    (* generation of new symbol file allowed *)
  96.         ptrinit = 5;    (* pointer initialization *)
  97.         nilchk = 7;    (* nil checks *)
  98.         powerpc = 10;    (* use PowerPC instruction set *)
  99.         (* fields in the POWER architecture instruction encoding *)
  100.         fAA = 00000002H;
  101.         fBA = 00010000H;
  102.         fBB = 00000800H;
  103.         fBD = 00000004H;
  104.         fBF = 00800000H;
  105.         fBFA = 00040000H;
  106.         fBI = 00010000H;
  107.         fBO = 00200000H;
  108.         fBT = 00200000H;
  109.         fD = 00000001H;
  110.         fEO = 00000002H;
  111.         fEO1 = 00000002H;
  112.         fFXM = 00001000H;
  113.         fFLM = 00020000H;
  114.         fFRA = 00010000H;
  115.         fFRB = 00000800H;
  116.         fFRC = 00000040H;
  117.         fFRS = 00200000H;
  118.         fFRT = 00200000H;
  119.         fI = 00001000H;
  120.         fLI = 00000004H;
  121.         fMB = 00000040H;
  122.         fME = 00000002H;
  123.         fNB = 00000800H;
  124.         fOE = 00000400H;
  125.         fOPCD = 04000000H;
  126.         fRA = 00010000H;
  127.         fRB = 00000800H;
  128.         fRS = 00200000H;
  129.         fRT = 00200000H;
  130.         fSH = 00000800H;
  131.         fSI = 00000001H;
  132.         fSPR = 00010000H;
  133.         fTO = 00200000H;
  134.         fLK = 00000001H;
  135.         fUI = 00000001H;
  136.         fXO = 00000002H;
  137.         fREC = 1;
  138.         (* condition code bits *)
  139.         bLT = 0; bGT = 1; bEQ = 2; bSO = 3;
  140.         (* special register definitions *)
  141.         SB = 2; SP = 1; SLpar = 11; virtualFP = 32; spCTR = 9; spMQ = 0; spLR = 8; spXER = 1;
  142.         (* opcodes of the POWER architecture *)
  143.         iA =  7C000014H;
  144.         iADDC = iA;
  145.         iABS =  7C0002D0H;
  146.         iAE =  7C000114H;
  147.         iAI =  30000000H;
  148.         iADDIC = iAI;
  149.         iADDICR = 34000000H;
  150.         iAME =  7C0001D4H;
  151.         iAND =  7C000038H;
  152.         iANDC =  7C000078H;
  153.         iANDIL =  70000000H;
  154.         iANDIU =  74000000H;
  155.         iAZE =  7C000194H;
  156.         iB =  48000000H;
  157.         iBC =  40000000H;
  158.         iBCC =  4C000420H;
  159.         iBCR =  4C000020H;
  160.         iCAL =  38000000H;
  161.         iCAU =  3C000000H;
  162.         iCAX =  7C000214H;
  163.         iADDI = iCAL;
  164.         iADD = iCAX;
  165.         iCLCS =  7C000426H;
  166.         iCLF =  7C0000ECH;
  167.         iCLI =  7C0003ECH;
  168.         iCMP =  7C000000H;
  169.         iCMPI =  2C000000H;
  170.         iCMPL =  7C000040H;
  171.         iCMPLI =  28000000H;
  172.         iCNTLZ =  7C000034H;
  173.         iCRAND =  4C000202H;
  174.         iCRANDC =  4C000102H;
  175.         iCREQV =  4C000242H;
  176.         iCRNAND =  4C0001C2H;
  177.         iCRNOR =  4C000042H;
  178.         iCROR =  4C000382H;
  179.         iCRORC =  4C000342H;
  180.         iCRXOR =  4C000182H;
  181.         iDCLST =  7C0004ECH;
  182.         iDCLZ =  7C0007ECH;
  183.         iDCS =  7C0004ACH;
  184.         iDIV =  7C000296H;
  185.         iDIVS =  7C0002D6H;
  186.         iDOZ =  7C000210H;
  187.         iDOZI =  24000000H;
  188.         iEQV =  7C000238H;
  189.         iEXTS =  7C000734H;
  190.         iEXTSB = 7C000774H;
  191.         iFA = 0FC00002AH;
  192.         iFADDS = 0EC00002AH;
  193.         iFABS = 0FC000210H;
  194.         iFCMPO = 0FC000040H;
  195.         iFCMPU = 0FC000000H;
  196.         iFD = 0FC000024H;
  197.         iFDIVS = 0EC000024H;
  198.         iFM = 0FC000032H;
  199.         iFMULS = 0EC000032H;
  200.         iFMA = 0FC00003AH;
  201.         iFMADDS = 0EC00003AH;
  202.         iFMR = 0FC000090H;
  203.         iFMS = 0FC000038H;
  204.         iFMSUBS = 0EC000038H;
  205.         iFNABS = 0FC000110H;
  206.         iFNEG = 0FC000050H;
  207.         iFNMA = 0FC00003EH;
  208.         iFNMADDS = 0EC00003EH;
  209.         iFNMS = 0FC00003CH;
  210.         iFNMSUBS = 0EC00003CH;
  211.         iFRSP = 0FC000018H;
  212.         iFS = 0FC000028H;
  213.         iFSUBS = 0EC000028H;
  214.         iICS =  4C00012CH;
  215.         iL = 080000000H;
  216.         iLBRX =  7C00042CH;
  217.         iLBZ = 088000000H;
  218.         iLBZU = 08C000000H;
  219.         iLBZUX =  7C0000EEH;
  220.         iLBZX =  7C0000AEH;
  221.         iLFD = 0C8000000H;
  222.         iLFDU = 0CC000000H;
  223.         iLFDUX =  7C0004EEH;
  224.         iLFDX =  7C0004AEH;
  225.         iLFS = 0C0000000H;
  226.         iLFSU = 0C4000000H;
  227.         iLFSUX =  7C00046EH;
  228.         iLFSX =  7C00042EH;
  229.         iLHA = 0A8000000H;
  230.         iLHAU = 0AC000000H;
  231.         iLHAUX =  7C0002EEH;
  232.         iLHAX =  7C0002AEH;
  233.         iLHBRX =  7C00062CH;
  234.         iLHZ = 0A0000000H;
  235.         iLHZU = 0A4000000H;
  236.         iLHZUX =  7C00026EH;
  237.         iLHZX =  7C00022EH;
  238.         iLM = 0B8000000H;
  239.         iLSCBX =  7C00022AH;
  240.         iLSI =  7C0004AAH;
  241.         iLSX =  7C00042AH;
  242.         iLU = 084000000H;
  243.         iLUX =  7C00006EH;
  244.         iLX =  7C00002EH;
  245.         iMASKG =  7C00003AH;
  246.         iMASKIR =  7C00043AH;
  247.         iMCRF =  4C000000H;
  248.         iMCRFS = 0FC000080H;
  249.         iMCRXR =  7C000400H;
  250.         iMFCR =  7C000026H;
  251.         iMFFS = 0FC00048EH;
  252.         iMFMSR =  7C0000A6H;
  253.         iMFSPR =  7C0002A6H;
  254.         iMFSR =  7C0004A6H;
  255.         iMFSRI =  7C0004E6H;
  256.         iMTCRF =  7C000120H;
  257.         iMTFSB0 = 0FC00008CH;
  258.         iMTFSB1 = 0FC00004CH;
  259.         iMTFSF = 0FC00058EH;
  260.         iMTSFI = 0FC00010CH;
  261.         iMTMSR =  7C000124H;
  262.         iMTSPR =  7C0003A6H;
  263.         iMTXER = iMTSPR+spXER*fSPR;
  264.         iMTSR =  7C0001A4H;
  265.         iMTSRI =  7C0001E4H;
  266.         iMUL =  7C0000D6H;
  267.         iMULI =  1C000000H;
  268.         iMULS =  7C0001D6H;
  269.         iNABS =  7C0003D0H;
  270.         iNAND =  7C0003B8H;
  271.         iNEG =  7C0000D0H;
  272.         iNOR =  7C0000F8H;
  273.         iOR =  7C000378H;
  274.         iORC =  7C000338H;
  275.         iORIL =  60000000H;
  276.         iORIU =  64000000H;
  277.         iRAC =  7C000664H;
  278.         iRFI =  4C000064H;
  279.         iRFSVC =  4C0000A4H;
  280.         iRLIMI =  50000000H;
  281.         iRLINM =  54000000H;
  282.         iRLMI =  58000000H;
  283.         iRLNM =  5C000000H;
  284.         iRRIB =  7C000432H;
  285.         iSF =  7C000010H;
  286.         iSFE =  7C000110H;
  287.         iSFI =  20000000H;
  288.         iSFME =  7C0001D0H;
  289.         iSFZE =  7C000190H;
  290.         iSL =  7C000030H;
  291.         iSLE =  7C000132H;
  292.         iSLEQ =  7C0001B2H;
  293.         iSLIQ =  7C000170H;
  294.         iSLLIQ =  7C0001F0H;
  295.         iSLLQ =  7C0001B0H;
  296.         iSLQ =  7C000130H;
  297.         iSR =  7C000430H;
  298.         iSRA =  7C000630H;
  299.         iSRAI =  7C000670H;
  300.         iSRAIQ =  7C000770H;
  301.         iSRAQ =  7C000730H;
  302.         iSRE =  7C000532H;
  303.         iSREA =  7C000732H;
  304.         iSREQ =  7C0005B2H;
  305.         iSRIQ =  7C000570H;
  306.         iSRLIQ =  7C0005F0H;
  307.         iSRLQ =  7C0005B0H;
  308.         iSRQ =  7C000530H;
  309.         iST = 90000000H;
  310.         iSTB = 98000000H;
  311.         iSTBRX =  7C00052CH;
  312.         iSTBU = 9C000000H;
  313.         iSTBUX =  7C0001EEH;
  314.         iSTBX =  7C0001AEH;
  315.         iSTFD = 0D8000000H;
  316.         iSTFDU = 0DC000000H;
  317.         iSTFDUX =  7C0005EEH;
  318.         iSTFDX =  7C0005AEH;
  319.         iSTFS = 0D0000000H;
  320.         iSTFSU = 0D4000000H;
  321.         iSTFSUX =  7C00056EH;
  322.         iSTFSX =  7C00052EH;
  323.         iSTH = 0B0000000H;
  324.         iSTHBRX =  7C00072CH;
  325.         iSTHU = 0B4000000H;
  326.         iSTHUX =  7C00036EH;
  327.         iSTHX =  7C00032EH;
  328.         iSTM = 0BC000000H;
  329.         iSTSI =  7C0005AAH;
  330.         iSTSX =  7C00052AH;
  331.         iSTU = 94000000H;
  332.         iSTUX =  7C00016EH;
  333.         iSTX =  7C00012EH;
  334.         iSVC =  44000000H;
  335.         iT =  7C000008H;
  336.         iTI =  0C000000H;
  337.         iTLBI =  7C000264H;
  338.         iXOR =  7C000278H;
  339.         iXORIL =  68000000H;
  340.         iXORIU =  6C000000H;
  341.         iBCNT = iBC+16*fBO;
  342.         iBDNZ = iBCNT;
  343.         iBDZ = iBC+18*fBO;
  344.         iNOT = iSFI+0FFFFH;
  345.         iUPPER = 4000000H;
  346.         iBT = iBC+15*fBO;
  347.         iBF = iBC+7*fBO;
  348.         iBA = iBC+31*fBO;
  349.         iBCNTNZ = iBC+16*fBO;
  350.         iBCNTNZNM = iBC+0*fBO+bEQ*fBI;
  351.         iBM = iBT+bEQ*fBI;
  352.         iBNM = iBF+bEQ*fBI;
  353.         iLIL = iCAL;
  354.         cALWAYS = 1FH;
  355.         (* trap numbers *)
  356.         IndexCheck = 1; DivideTrap = 2; CaseTrap = 3; TypeGuard = 4; FuncTrap = 5; DimTrap = 6; NilTrap = 7;
  357.         (* trap fields *)
  358.         tUGE = 5; tULE = 6; tNEQ = 27; tEQ = 4; tSLE = 20; tALWAYS = 31;
  359.         (* tags *)
  360.         SYSMTag = 0FFX; NewRecETag = 0FFX; NewSysETag = 0FEX; NewArrETag = 0FDX;
  361.         LinkMTag = 0FEX; CaseETag = 0FFX;
  362.         LowWord = 10000H;
  363.         FP: LONGINT;
  364.         BLI, XLI, BSI, XSI: ARRAY Pointer+1 OF LONGINT;
  365.         options: SET;
  366.         IntToRealAddr, RealToIntAddr, scratch: LONGINT;
  367.         IntToRealBlock, RealToIntBlock: ARRAY 16 OF CHAR;
  368.         zero, CAPmask: OPL.Item;
  369.         LoopLevel: INTEGER;
  370.         leaveProc: OPL.Label;
  371.         FPlink, FPlink4: OPL.Label;
  372.         LoopStart, LoopEnd: ARRAY OPM.MaxExit OF OPL.Label;
  373.         CRbit, switch: ARRAY geq-eql+1 OF INTEGER;
  374.         aopSize, sSize, SLsize: LONGINT;
  375.         SBoffset, CaseLink: LONGINT;
  376.         NewRecEntry, NewSysEntry, NewArrEntry: LONGINT;
  377.     PROCEDURE CNTLZ (i: LONGINT): LONGINT;
  378.         VAR j: LONGINT; s: SET;
  379.     BEGIN
  380.         IF OPM.CeresVersion THEN s := SYSTEM.VAL(SET, i); j := 31;    (* note: Ceres specific *)
  381.             WHILE ~(j IN s) & (j >= 0) DO DEC(j) END;
  382.             RETURN 31-j
  383.         ELSE
  384.             s := SYSTEM.VAL(SET, i); j := 0;
  385.             WHILE ~(j IN s) & (j < 32) DO INC(j) END;
  386.             RETURN j
  387.         END
  388.     END CNTLZ;
  389.     PROCEDURE MoveReg(rt, rs: LONGINT);
  390.     BEGIN
  391.         IF rs # 0 THEN OPL.Put(iCAL+rt*fRT+rs*fRA) ELSE OPL.Put(iAI+rt*fRT+rs*fRA) END
  392.     END MoveReg;
  393.     PROCEDURE IMIN (a, b: LONGINT): LONGINT;
  394.     BEGIN IF a < b THEN RETURN a ELSE RETURN b END
  395.     END IMIN;
  396.     PROCEDURE CheckR (rt: LONGINT): LONGINT;
  397.     BEGIN IF rt < 0 THEN RETURN OPL.GetTempR() ELSE RETURN rt END
  398.     END CheckR;
  399.     PROCEDURE CheckF (rt: LONGINT): LONGINT;
  400.     BEGIN IF rt < 0 THEN RETURN OPL.GetTempF() ELSE RETURN rt END
  401.     END CheckF;
  402.     PROCEDURE CheckCRB (rt: LONGINT): LONGINT;
  403.     BEGIN IF rt < 0 THEN RETURN OPL.GetTempCRB() ELSE RETURN rt END
  404.     END CheckCRB;
  405.     PROCEDURE CheckVFP (r: LONGINT): LONGINT;
  406.     BEGIN (*IF r = virtualFP THEN OPL.FixMark; RETURN SP ELSE RETURN r END*) RETURN r
  407.     END CheckVFP;
  408.     PROCEDURE^ Load* (VAR x: OPL.Item; rt: LONGINT);
  409.     PROCEDURE^ RegToCond (VAR x: OPL.Item);
  410.     PROCEDURE PutBranchInstr (instr: LONGINT; VAR l: OPL.Label);
  411.         VAR ll: LONGINT;
  412.     BEGIN
  413.         IF l > 0 THEN ll := l-OPL.pc ELSE ll := l END;
  414.         ll := ll MOD 4000H; OPL.Put(instr+ll*4);
  415.         IF l <= 0 THEN l := SHORT(-OPL.pc+1) END
  416.     END PutBranchInstr;
  417.     PROCEDURE PutBranch* (VAR l: OPL.Label);
  418.     BEGIN PutBranchInstr(iBA, l)
  419.     END PutBranch;
  420.     PROCEDURE PutCondBranch* (VAR x: OPL.Item; Tjmp: BOOLEAN);
  421.         VAR pospol: BOOLEAN; cbit, l: LONGINT;
  422.     BEGIN
  423.         IF x.mode = Con THEN
  424.             IF Tjmp = (x.offset # 1) THEN RETURN    (* optimize untaken or taken branches *)
  425.             ELSIF Tjmp THEN PutBranch(x.Tjmp)
  426.             ELSE PutBranch(x.Fjmp)
  427.             END
  428.         END;
  429.         IF x.mode # Cond THEN Load(x, -1); RegToCond(x) END;
  430.         cbit := x.reg; pospol := cbit >= 0; IF ~pospol THEN cbit := -1-cbit END;
  431.         IF Tjmp THEN l := x.Tjmp ELSE l := x.Fjmp END;
  432.         IF l > 0 THEN l := l-OPL.pc END; l := l MOD 4000H; OPL.FreeTempCRBs({cbit});
  433.         IF pospol = Tjmp THEN OPL.Put(iBT+cbit*fBI+l*4) ELSE OPL.Put(iBF+cbit*fBI+l*4) END;
  434.         IF Tjmp THEN
  435.             IF x.Tjmp <= 0 THEN x.Tjmp := SHORT(-OPL.pc+1) END
  436.         ELSE
  437.             IF x.Fjmp <= 0 THEN x.Fjmp := SHORT(-OPL.pc+1) END
  438.         END
  439.     END PutCondBranch;
  440.     PROCEDURE SetLabel* (VAR l: OPL.Label);
  441.     BEGIN
  442.         IF l < 0 THEN OPL.Fixup(l) ELSE l := SHORT(OPL.pc) END
  443.     END SetLabel;
  444.     PROCEDURE MoveCond (VAR x: OPL.Item; rt: LONGINT): LONGINT;
  445.         VAR instr, src: LONGINT; l: OPL.Label;
  446.     BEGIN
  447.         src := x.reg; l := 0;
  448.         IF (x.Tjmp = 0) & (x.Fjmp = 0) THEN
  449.             IF src < 0 THEN src := -1-src; instr := iCRNOR ELSE instr := iCROR END;
  450.             OPL.FreeTempCRBs({src}); rt := CheckCRB(rt); OPL.Put(instr+rt*fBT+src*fBA+src*fBB)
  451.         ELSE
  452.             rt := CheckCRB(rt); PutCondBranch(x, FALSE);
  453.             OPL.Fixup(x.Tjmp); OPL.Put(iCREQV+rt*fBT); PutBranch(l);
  454.             OPL.Fixup(x.Fjmp); OPL.Put(iCRXOR+rt*fBT); OPL.Fixup(l)
  455.         END;
  456.         RETURN rt
  457.     END MoveCond;
  458.     PROCEDURE CondToReg (VAR x: OPL.Item; rt: LONGINT);
  459.         VAR src, t: LONGINT; l: OPL.Label;
  460.     BEGIN
  461.         ASSERT(x.mode = Cond);
  462.         src := x.reg;
  463.         IF (x.Tjmp = 0) & (x.Fjmp = 0) THEN
  464.             src := x.reg; IF src < 0 THEN src := MoveCond(x, -1) END;
  465.             OPL.FreeTempCRBs({src}); t := OPL.GetTempR(); OPL.Put(iMFCR+t*fRT);
  466.             OPL.FreeTempR(t); rt := CheckR(rt); OPL.Put(iRLINM+rt*fRA+t*fRS+((src+1) MOD 32)*fSH+31*fMB+31*fME);
  467.         ELSE
  468.             rt := CheckR(rt); PutCondBranch(x, FALSE);
  469.             SetLabel(x.Tjmp); OPL.Put(iCAL+rt*fRT+1); l := 0; PutBranch(l);
  470.             SetLabel(x.Fjmp); OPL.Put(iCAL+rt*fRT); SetLabel(l)
  471.         END;
  472.         x.mode := Reg; x.reg := rt
  473.     END CondToReg;
  474.     PROCEDURE RegToCond (VAR x: OPL.Item);
  475.         VAR src, t: LONGINT;
  476.     BEGIN
  477.         ASSERT(x.mode IN {Reg, RegSI});
  478.         src := x.reg; OPL.FreeTempR(src); t := OPL.GetTempCRF(); OPL.Put(iCMPI+t*fBF+src*fRA+0);    (* << mmb 16.12.91 *)
  479.         t := t*4; OPL.FreeTempCRBs({t..t+3}-{t+bEQ}); x.mode := Cond; x.reg := -1-(t+bEQ)
  480.     END RegToCond;
  481.     PROCEDURE FindFP (curlev, tofind, rt: LONGINT): LONGINT;
  482.         VAR y: OPL.Item;
  483.     BEGIN
  484.         ASSERT(curlev >= tofind);
  485.         IF curlev = tofind THEN RETURN FP
  486.         ELSE
  487.             y.mode := Based; y.reg := FP; y.offset := -4; y.typ := OPT.linttyp; y.dreg := -1;
  488.             WHILE curlev > tofind+1 DO Load(y, -1); y.mode := Based; y.offset := -4; DEC(curlev) END;
  489.             Load(y, rt); RETURN y.reg
  490.         END
  491.     END FindFP;
  492.     PROCEDURE ReduceIndex (VAR x: OPL.Item; inx, rt: LONGINT);
  493.         VAR src: LONGINT;
  494.     BEGIN
  495.         ASSERT(x.mode IN {Indexed, Based});
  496.         src := x.reg; OPL.FreeTempR(src); OPL.FreeTempR(inx); rt := CheckR(rt);
  497.         OPL.Put(iCAX+rt*fRT+src*fRA+inx*fRB); x.reg := rt
  498.     END ReduceIndex;
  499.     PROCEDURE BaseOrInx (VAR x: OPL.Item; rt: LONGINT);
  500.         VAR offset, mnolev, t: LONGINT; typ: OPT.Struct; DArr: BOOLEAN;
  501.     BEGIN
  502.         DArr := x.typ.comp = DynArr;
  503.         CASE x.mode OF
  504.             Based, Indexed:
  505.         |  Var, VarPar:
  506.                 mnolev := x.mnolev;
  507.                 IF mnolev < 0 THEN
  508.                     offset := x.offset; typ := x.typ; x.mode := Based; x.reg := SB;
  509.                     x.offset := -(mnolev*4)+OPL.linkTable; x.typ := OPT.linttyp;
  510.                     t := rt; IF offset # 0 THEN t := -1 END;
  511.                     Load(x, t); x.mode := Based; x.offset := offset; x.typ := typ
  512.                 ELSIF mnolev = 0 THEN
  513.                     x.mode := Based; x.reg := SB
  514.                 ELSIF (x.mode = VarPar) OR DArr THEN
  515.                     x.reg := FindFP(OPL.level, x.mnolev, -1);
  516.                     IF DArr THEN t := x.reg; offset := x.offset END;
  517.                     x.mode := Based; typ := x.typ; x.typ := OPT.linttyp; Load(x, -1);
  518.                     x.mode := Based; x.offset := 0; x.typ := typ;
  519.                     IF DArr THEN x.dreg := SHORT(SHORT(t)); x.adr := offset; x.dmode := Based END
  520.                 ELSE
  521.                     x.reg := FindFP(OPL.level, x.mnolev, -1); x.mode := Based
  522.                 END
  523.         ELSE OPM.err(127)    (* illegal use of object *)
  524.         END
  525.     END BaseOrInx;
  526.     PROCEDURE Base (VAR x: OPL.Item; rt: LONGINT);
  527.     BEGIN
  528.         IF x.mode = Indexed THEN ReduceIndex(x, x.offset, rt); x.mode := Based; x.offset := 0 ELSE BaseOrInx(x, rt) END;
  529.         ASSERT(x.mode = Based);
  530.     END Base;
  531.     PROCEDURE ShortBase (VAR x: OPL.Item; rt: LONGINT);
  532.         VAR u, l, base: LONGINT;
  533.     BEGIN
  534.         ASSERT(x.mode = Based);
  535.         u := x.offset; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  536.         IF u # 0 THEN
  537.             base := x.reg; OPL.FreeTempR(base); rt := CheckR(rt); OPL.Put(iCAU+rt*fRT+base*fRA+u); x.reg := rt;
  538.             x.offset := ASH(SYSTEM.LSH(l, 16), -16)
  539.         END;
  540.     END ShortBase;
  541.     PROCEDURE MakeReg (VAR x: OPL.Item; rt: LONGINT);
  542.         VAR s, t: LONGINT;
  543.     BEGIN
  544.         ASSERT(x.mode IN {Reg, RegSI});
  545.         IF x.mode = RegSI THEN
  546.             s := x.reg; OPL.FreeTempR(s);
  547.             IF powerpc IN options THEN
  548.                 rt := CheckR(rt); OPL.Put(iEXTSB+rt*fRA+s*fRS)
  549.             ELSE
  550.                 t := OPL.GetTempR(); OPL.Put(iRLINM+t*fRA+s*fRS+24*fSH+31*fME);
  551.                 OPL.FreeTempR(t); rt := CheckR(rt); OPL.Put(iSRAI+rt*fRA+t*fRS+24*fSH)
  552.             END;
  553.             x.reg := rt; x.mode := Reg
  554.         END
  555.     END MakeReg;
  556.     PROCEDURE LoadAddr* (VAR x: OPL.Item; rt: LONGINT);
  557.         VAR u, l, base, inx, t: LONGINT;
  558.     BEGIN
  559.         BaseOrInx(x, rt); base := x.reg;
  560.         IF x.mode = Based THEN
  561.             u := x.offset; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  562.             IF u # 0 THEN
  563.                 ASSERT(base # virtualFP);
  564.                 OPL.FreeTempR(base);
  565.                 IF l # 0 THEN
  566.                     t := OPL.GetTempR(); OPL.Put(iCAU+t*fRT+base*fRA+u);
  567.                     OPL.FreeTempR(t); rt := CheckR(rt); OPL.Put(iCAL+rt*fRT+t*fRA+l)
  568.                 ELSE
  569.                     rt := CheckR(rt); OPL.Put(iCAU+rt*fRT+base*fRA+u)
  570.                 END
  571.             ELSIF l # 0 THEN
  572.                 base := CheckVFP(base); OPL.FreeTempR(base); rt := CheckR(rt); OPL.Put(iCAL+rt*fRT+base*fRA+l)
  573.             ELSIF base = 0 THEN (* load constant 0 *)
  574.                 rt := CheckR(rt); OPL.Put(iCAL+rt*fRT)
  575.             ELSE rt := base (* do not move *)
  576.             END
  577.         ELSE
  578.             ASSERT(base # virtualFP); inx := x.offset;
  579.             OPL.FreeTempR(base); OPL.FreeTempR(inx); rt := CheckR(rt); OPL.Put(iCAX+rt*fRT+base*fRA+inx*fRB)
  580.         END;
  581.         IF x.dreg # -1 THEN OPL.UnholdTempR(x.dreg);
  582.             IF x.dreg # rt THEN OPL.FreeTempR(x.dreg) END;
  583.             x.dreg := -1
  584.         END;
  585.         x.mode := Reg; x.reg := rt; x.typ := OPT.linttyp
  586.     END LoadAddr;
  587.     PROCEDURE Load* (VAR x: OPL.Item; rt: LONGINT);
  588.         VAR form, base: LONGINT; RealType: BOOLEAN;
  589.     BEGIN
  590.         form := x.typ^.form; RealType := form IN RealTypes;
  591.         ASSERT(x.typ^.form IN {Byte, Bool, Char, SInt, Int, LInt, Real, LReal, Set, NilTyp, Pointer});
  592.         CASE x.mode OF
  593.             Reg, RegSI, FReg, Cond:
  594.                 rt := x.reg
  595.         |  Var, VarPar, Based:
  596.                 BaseOrInx(x, -1); ShortBase(x, -1);
  597.                 ASSERT(x.mode = Based);
  598.                 base := x.reg; OPL.FreeTempR(base); base := CheckVFP(base);
  599.                 IF RealType THEN rt := CheckF(rt); x.mode := FReg ELSE rt := CheckR(rt); x.mode := Reg END;
  600.                 OPL.Put(BLI[form]+rt*fRT+base*fRA+(x.offset MOD LowWord));
  601.                 IF form = SInt THEN x.mode := RegSI END
  602.         |  Indexed:
  603.                 base := x.reg; OPL.FreeTempR(base); ASSERT(base # virtualFP);
  604.                 IF RealType THEN rt := CheckF(rt); x.mode := FReg ELSE rt := CheckR(rt); x.mode := Reg END;
  605.                 OPL.Put(XLI[form]+rt*fRT+base*fRA+x.offset*fRB); OPL.FreeTempR(x.offset);
  606.                 IF form = SInt THEN x.mode := RegSI END
  607.         |  Con:
  608.                 ASSERT(x.typ^.form IN {Byte, Bool, Char, SInt, Int, LInt, Set, NilTyp, Pointer});
  609.                 x.mode := Based; x.reg := 0; LoadAddr(x, rt); rt := x.reg
  610.         END;
  611.         x.reg := rt;
  612.         IF x.dreg # -1 THEN OPL.UnholdTempR(x.dreg);
  613.             IF (x.dreg # rt) OR RealType THEN OPL.FreeTempR(x.dreg) END;
  614.             x.dreg := -1
  615.         END
  616.     END Load;
  617.     PROCEDURE Store (VAR x, y: OPL.Item);
  618.         VAR smode, dmode, dest, src, inx, form: LONGINT;
  619.     BEGIN
  620.         ASSERT((x.typ^.form = y.typ^.form) &
  621.                     (x.typ^.form IN {Byte, Bool, Char, SInt, Int, LInt, Real, LReal, Set, Pointer, NilTyp}));
  622.         form := x.typ^.form; smode := y.mode; dmode := x.mode;
  623.         ASSERT(y.mode IN {Reg, RegSI, FReg, Cond});
  624.         IF (form = Bool) & ((y.Tjmp # 0) OR (y.Fjmp # 0)) & (smode # Cond) THEN RegToCond(y); smode := Cond END;
  625.         CASE dmode OF
  626.             Reg, RegSI:
  627.                 dest := x.reg;
  628.                 IF smode = Cond THEN CondToReg(y, dest) END;
  629.                 IF y.mode = RegSI THEN MakeReg(y, dest) END;
  630.                 IF y.reg # dest THEN src := y.reg; OPL.FreeTempR(src); MoveReg(dest, src) END
  631.         |  FReg:
  632.                 src := y.reg; dest := x.reg; IF src # dest THEN OPL.FreeTempF(src); OPL.Put(iFMR+x.reg*fFRT+src*fFRB) END
  633.         |  Cond:
  634.                 dest := x.reg;
  635.                 IF smode = Reg THEN RegToCond(y) END;
  636.                 IF (y.Tjmp # 0) OR (y.Fjmp # 0) OR (y.reg # dest) THEN y.reg := MoveCond(y, dest); ASSERT(y.reg = dest) END    (* mah *)
  637. (*                IF y.reg # dest THEN y.reg := MoveCond(y, dest); ASSERT(y.reg = dest) END *)
  638.         |  Var, VarPar, Based:
  639.                 BaseOrInx(x, -1);
  640.                 IF smode = Cond THEN CondToReg(y, -1)
  641.                 ELSIF smode = RegSI THEN MakeReg(y, -1)
  642.                 END;
  643.                 ShortBase(x, -1); src := y.reg; dest := x.reg;
  644.                 IF smode = FReg THEN OPL.FreeTempF(src) ELSE OPL.FreeTempR(src) END;
  645.                 OPL.FreeTempR(dest); OPL.Put(BSI[form]+src*fRS+dest*fRA+(x.offset MOD LowWord))
  646.         |  Indexed:
  647.                 IF smode = Cond THEN CondToReg(y, -1)
  648.                 ELSIF smode = RegSI THEN MakeReg(y, -1)
  649.                 END;
  650.                 src := y.reg; dest := x.reg; inx := x.offset;
  651.                 IF smode = FReg THEN OPL.FreeTempF(src) ELSE OPL.FreeTempR(src) END;
  652.                 OPL.FreeTempR(dest); OPL.FreeTempR(inx); OPL.Put(XSI[form]+src*fRS+dest*fRA+inx*fRB)
  653.         END;
  654.         IF x.dreg # -1 THEN OPL.UnholdTempR(x.dreg); OPL.FreeTempR(x.dreg); x.dreg := -1 END
  655.     END Store;
  656.     PROCEDURE Move (VAR x, y, z: OPL.Item; aligned8: BOOLEAN);
  657.         VAR src, dest, r1, r2, iter, slack, h, l: LONGINT; loop, loopend: OPL.Label;
  658.     BEGIN
  659.         (* this is the long version *)
  660.         loop := 0; loopend := 0;
  661.         IF z.mode = Con THEN
  662.             iter := z.offset DIV 8; slack := z.offset MOD 8;
  663.             r1 := OPL.GetTempRegs(2, {}); r2 := r1+1;
  664.             IF iter > 0 THEN
  665.                 Base(x, -1); Base(y, -1);
  666.                 (* before entering the pipelined loop, dest is at offset -4, src at offset 0 *)
  667.                 DEC(x.offset, 4); LoadAddr(x, -1); LoadAddr(y, -1); src := y.reg; dest := x.reg;
  668.                 IF ~(src IN OPL.TempRegs) THEN src := OPL.GetTempR(); MoveReg(src, y.reg) END;
  669.                 IF ~(dest IN OPL.TempRegs) THEN dest := OPL.GetTempR(); MoveReg(dest, x.reg) END;
  670.                 IF iter > 1 THEN DEC(iter);
  671.                     IF iter > 1 THEN
  672.                         IF iter > 32767 THEN
  673.                             l := iter MOD LowWord; h := (SYSTEM.LSH(iter, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  674.                             OPL.Put(iCAU+r1*fRT+h); OPL.Put(iCAL+r1*fRT+r1*fRA+l)
  675.                         ELSE
  676.                             OPL.Put(iCAL+r1*fRT+iter)
  677.                         END;
  678.                         OPL.Put(iMTSPR+r1*fRS+spCTR*fSPR)
  679.                     END;
  680.                     OPL.Put(iL+r1*fRT+src*fRA+0);  OPL.Put(iL+r2*fRT+src*fRA+4);
  681.                     SetLabel(loop);
  682.                     OPL.Put(iST+r1*fRS+dest*fRA+4); OPL.Put(iLU+r1*fRT+src*fRA+8);
  683.                     OPL.Put(iSTU+r2*fRS+dest*fRA+8); OPL.Put(iL+r2*fRT+src*fRA+4);
  684.                     IF iter > 1 THEN PutBranchInstr(iBCNTNZ, loop) END;
  685.                     OPL.Put(iST+r1*fRS+dest*fRA+4); OPL.Put(iST+r2*fRS+dest*fRA+8)
  686.                     (* now, dest is at offset -12, and src at offset -8 *)
  687.                 ELSE
  688.                     OPL.Put(iL+r1*fRT+src*fRA+0); OPL.Put(iL+r2*fRT+src*fRA+4);
  689.                     OPL.Put(iST+r1*fRS+dest*fRA+4); OPL.Put(iST+r2*fRS+dest*fRA+8)
  690.                     (* as above, dest is at offset -12, src at offset -8 *)
  691.                 END;
  692.                 IF slack > 0 THEN OPL.Put(iCAL+src*fRT+src*fRA+8); OPL.Put(iCAL+dest*fRT+dest*fRA+12) END
  693.             ELSE
  694.                 CASE slack OF
  695.                 | 1: x.typ := OPT.bytetyp; y.typ := OPT.bytetyp; Load(y, -1); Store(x, y); slack := 0
  696.                 | 2: x.typ := OPT.inttyp; y.typ := OPT.inttyp; Load(y, -1); Store(x, y); slack := 0
  697.                 | 4: x.typ := OPT.linttyp; y.typ := OPT.linttyp; Load(y, -1); Store(x, y); slack := 0
  698.                 ELSE LoadAddr(x, -1); LoadAddr(y, -1); src := y.reg; dest := x.reg
  699.                 END
  700.             END;
  701.             IF slack > 0 THEN
  702.                 OPL.Put(iLSI+r1*fRT+src*fRA+slack*fNB); OPL.Put(iSTSI+r1*fRS+dest*fRA+slack*fNB)
  703.             END
  704.         ELSE
  705.             Base(x, -1); Base(y, -1);
  706.             DEC(x.offset, 4); DEC(y.offset, 4); LoadAddr(x, -1); LoadAddr(y, -1); src := y.reg; dest := x.reg;
  707.             r1 := OPL.GetTempRegs(2, {}); r2 := r1+1; Load(z, -1);
  708.             OPL.Put(iRLINM+z.reg*fRS+r1*fRA+29*fSH+3*fMB+31*fME+fREC); OPL.Put(iMTSPR+r1*fRS+spCTR*fSPR);
  709.             IF ~(src IN OPL.TempRegs) THEN src := OPL.GetTempR(); MoveReg(src, y.reg) END;
  710.             IF ~(dest IN OPL.TempRegs) THEN dest := OPL.GetTempR(); MoveReg(dest, x.reg) END;
  711.             IF ~aligned8 THEN
  712.                 OPL.Put(iRLINM+z.reg*fRS+r2*fRA+29*fMB+31*fME); OPL.Put(iMTSPR+r2*fRS+spXER*fSPR)
  713.             END;
  714.             OPL.FreeTempR(z.reg); loopend := 0; PutBranchInstr(iBM, loopend); SetLabel(loop);
  715.             OPL.Put(iLU+r1*fRT+src*fRA+4); OPL.Put(iLU+r2*fRT+src*fRA+4);
  716.             OPL.Put(iSTU+r1*fRS+dest*fRA+4); OPL.Put(iSTU+r2*fRS+dest*fRA+4);
  717.             PutBranchInstr(iBCNTNZ, loop); SetLabel(loopend);
  718.             IF ~aligned8 THEN
  719.                 slack := OPL.GetTempR(); OPL.Put(iCAL+slack*fRT+4);
  720.                 OPL.Put(iLSX+r1*fRT+slack*fRA+src*fRB); OPL.Put(iSTSX+r1*fRS+slack*fRA+dest*fRB);
  721.                 OPL.FreeTempR(slack)
  722.             END
  723.         END;
  724.         OPL.FreeTempR(r1); OPL.FreeTempR(r2); OPL.FreeTempR(src); OPL.FreeTempR(dest)
  725.     END Move;
  726.     PROCEDURE CommonDesign* (VAR x: OPL.Item);
  727.     BEGIN
  728.         IF x.mode IN {Var, VarPar, Based, Indexed} THEN
  729.             BaseOrInx(x, -1);
  730.             IF x.mode = Based THEN ShortBase(x, -1) END;
  731.             OPL.HoldTempR(x.reg);
  732.             IF x.mode = Indexed THEN OPL.HoldTempR(x.offset) END;
  733.         END
  734.     END CommonDesign;
  735.     PROCEDURE UnholdCommonDesign* (VAR x: OPL.Item);
  736.     BEGIN
  737.         IF x.mode IN {Based, Indexed} THEN OPL.UnholdTempR(x.reg);
  738.             IF x.mode = Indexed THEN OPL.UnholdTempR(x.offset) END;
  739.         END
  740.     END UnholdCommonDesign;
  741.     PROCEDURE^ Minus* (VAR x, y: OPL.Item; rt: LONGINT);
  742.     PROCEDURE^ Plus* (VAR x, y: OPL.Item; rt: LONGINT);
  743.     PROCEDURE Convert* (VAR x: OPL.Item; dtyp: OPT.Struct; rt: LONGINT; round: BOOLEAN);
  744.         VAR sform, dform, s, t: LONGINT; y, z: OPL.Item;
  745.     BEGIN
  746.         sform := x.typ^.form; dform := dtyp^.form; y.dreg := -1; z.dreg := -1;
  747.         IF sform # dform THEN
  748.             IF sform IN {Byte, Bool, Char, SInt, Int, LInt, Set, Pointer, NilTyp} THEN
  749.                 IF dform IN {Byte, Bool, Char, SInt, Int, LInt, Set, Pointer, NilTyp} THEN Load(x, rt)
  750.                 ELSE ASSERT(dform IN {Real, LReal});
  751.                     Load(x, -1); MakeReg(x, -1);
  752.                     IF IntToRealAddr = 0 THEN
  753.                         OPL.AllocConst(IntToRealBlock, 16, IntToRealAddr, 8);
  754.                         ASSERT((-32768 <= IntToRealAddr) & (IntToRealAddr <= 32767-16))
  755.                     END;
  756.                     s := x.reg; OPL.FreeTempR(s); t := OPL.GetTempR(); OPL.Put(iXORIU+t*fRA+s*fRS+8000H);
  757.                     OPL.FreeTempR(t); OPL.Put(iST+t*fRS+SB*fRA+((IntToRealAddr+12) MOD LowWord));
  758.                     x.mode := Based; x.reg := SB; x.offset := IntToRealAddr+8; x.typ := OPT.lrltyp;
  759.                     y.mode := Based; y.reg := SB; y.offset := IntToRealAddr; y.typ := OPT.lrltyp; y.dreg := -1;
  760.                     Minus(x, y, rt)
  761.                 END
  762.             ELSIF ~(dform IN {Real, LReal}) THEN (* ENTIER *)
  763.                 IF RealToIntAddr = 0 THEN OPL.AllocConst(RealToIntBlock, 8, RealToIntAddr, 8) END;
  764.                 IF scratch < 0 THEN scratch := OPL.dsize; INC(OPL.dsize, 8) END;
  765.                 t := OPL.GetTempF(); OPL.Put(iMFFS+t*fFRT); OPL.Put(iMTFSB1+30*fBT); OPL.Put(iMTFSB1+31*fBT);
  766.                 y.mode := Based; y.reg := SB; y.offset := RealToIntAddr; y.typ := OPT.lrltyp; Load(x, -1); x.typ := OPT.lrltyp;
  767.                 Plus(y, x, -1);
  768.                 z.mode := Based; z.reg := SB; z.offset := scratch; z.typ := OPT.lrltyp; Store(z, y);
  769.                 x.mode := Based; x.reg := SB;
  770.                 OPL.Put(iMTFSF+1*fFLM+t*fFRB); OPL.FreeTempF(t);
  771.                 IF dtyp^.form IN {Byte, Bool, Char, SInt} THEN x.offset := scratch+7
  772.                 ELSIF dtyp^.form = Int THEN x.offset := scratch+6
  773.                 ELSE x.offset := scratch+4
  774.                 END;
  775.                 x.typ := dtyp; Load(x, rt)
  776.             ELSE (* conversion between Real and LReal *)
  777.                 Load(x, rt);
  778.                 IF round & (sform = LReal) THEN ASSERT(dform = Real);
  779.                     OPL.FreeTempF(x.reg); rt := CheckF(rt); OPL.Put(iFRSP+rt*fFRT+x.reg*fFRB); x.reg := rt; x.typ := OPT.realtyp
  780.                 END
  781.             END
  782.         END;
  783.         x.typ := dtyp
  784.     END Convert;
  785.     PROCEDURE Field* (VAR x: OPL.Item; offset, rt: LONGINT);
  786.     BEGIN
  787.         IF offset = 0 THEN BaseOrInx(x, rt) ELSE Base(x, rt); INC(x.offset, offset) END;
  788.         ASSERT(x.mode IN {Based, Indexed});
  789.     END Field;
  790.     PROCEDURE^ Times* (VAR x, y: OPL.Item; rt: LONGINT);
  791.     PROCEDURE^ Ash* (VAR x, y: OPL.Item; rt: LONGINT);
  792.     PROCEDURE TypeSize* (VAR x: OPL.Item; typ: OPT.Struct; rt: LONGINT);
  793.         VAR y: OPL.Item; dmode: SHORTINT; dreg, doff, s: LONGINT;
  794.     BEGIN
  795.         IF typ^.comp # DynArr THEN
  796.             x.mode := Con; x.typ := OPT.linttyp; x.offset := typ^.size
  797.         ELSE
  798.             dmode := x.dmode; dreg := x.dreg; doff := x.adr; x.mode := dmode; x.typ := OPT.linttyp;
  799.             IF dmode = Reg THEN x.reg := dreg+typ^.offset DIV 4 ELSE x.reg := dreg; x.offset := doff+typ^.offset END;
  800.             typ := typ^.BaseTyp; x.dreg := -1;
  801.             WHILE typ^.comp = DynArr DO
  802.                 y.mode := dmode; y.typ := OPT.linttyp; y.dreg := -1;
  803.                 IF dmode = Reg THEN y.reg := dreg+typ^.offset DIV 4 ELSE y.reg := dreg; y.offset := doff+typ^.offset END;
  804.                 s := rt; typ := typ^.BaseTyp;
  805.                 IF (typ^.comp = DynArr) OR (typ^.size > 1) THEN s := -1 END;
  806.                 Times(x, y, s)
  807.             END;
  808.             s := typ^.size;
  809.             IF s > 1 THEN
  810.                 y.mode := Con; y.dreg := -1;
  811.                 IF SYSTEM.VAL(SET, s)*SYSTEM.VAL(SET, s-1) = {} THEN
  812.                     y.offset := 31-CNTLZ(s); Ash(x, y, rt)
  813.                 ELSE
  814.                     y.offset := s; Times(x, y, rt)
  815.                 END
  816.             END;
  817.             x.dreg := SHORT(SHORT(dreg))
  818.         END
  819.     END TypeSize;
  820.     PROCEDURE MulOrShift (VAR x, y: OPL.Item; rt: LONGINT);
  821.         VAR n: LONGINT; z: OPL.Item;
  822.     BEGIN
  823.         ASSERT(y.mode = Con);
  824.         n := y.offset;
  825.         IF x.mode = Con THEN x.offset := x.offset * n
  826.         ELSIF n > 1 THEN
  827.             IF SYSTEM.VAL(SET, n)*SYSTEM.VAL(SET, n-1) = {} THEN z := y; z.offset := 31-CNTLZ(n); Ash(x, z, rt)
  828.             ELSE Times(x, y, rt)
  829.             END
  830.         END
  831.     END MulOrShift;
  832.     PROCEDURE MulDim* (VAR nofel, len: OPL.Item; rt: LONGINT);
  833.         VAR y: OPL.Item;
  834.     BEGIN
  835.         IF nofel.mode = Con THEN
  836.             IF len.mode = Con THEN nofel.offset := nofel.offset*len.offset
  837.             ELSE y := len; MulOrShift(y, nofel, rt); nofel := y
  838.             END
  839.         ELSE
  840.             IF len.mode = Con THEN MulOrShift(nofel, len, rt)
  841.             ELSE Times(nofel, len, rt)
  842.             END
  843.         END
  844.     END MulDim;
  845.     PROCEDURE GenDimTrap* (VAR len: OPL.Item);
  846.     BEGIN
  847.         IF inxchk IN options THEN Load(len, -1); OPL.SetTrap(DimTrap); OPL.Put(iTI+tSLE*fTO+len.reg*fRA) END
  848.     END GenDimTrap;
  849.     PROCEDURE Index* (VAR x, y: OPL.Item; rt: LONGINT);
  850.         VAR t, n, elemSize, inx: LONGINT; mode: SHORTINT; basedRes: BOOLEAN; v, z: OPL.Item;
  851.     BEGIN
  852.         z.dreg := -1;
  853.         IF x.typ^.comp = Array THEN
  854.             BaseOrInx(x, -1); elemSize := x.typ^.BaseTyp^.size;
  855.             IF y.mode = Con THEN Field(x, y.offset*elemSize, rt)
  856.             ELSE
  857.                 IF x.mode = Indexed THEN ReduceIndex(x, x.offset, -1); x.offset := 0; x.mode := Based END;
  858.                 basedRes := x.offset # 0; Load(y, -1); MakeReg(y, -1); t := rt; IF basedRes THEN t := -1 END;
  859.                 IF inxchk IN options THEN
  860.                     n := x.typ^.n; inx := y.reg;
  861.                     IF n < 7FFFH THEN OPL.SetTrap(IndexCheck); OPL.Put(iTI+tUGE*fTO+inx*fRA+n)
  862.                     ELSE
  863.                         z.mode := Con; z.typ := OPT.linttyp; z.offset := n; Load(z, -1); t := z.reg; OPL.FreeTempR(t);
  864.                         OPL.SetTrap(IndexCheck); OPL.Put(iT+tUGE*fTO+inx*fRA+t*fRB)
  865.                     END
  866.                 END;
  867.                 z.mode := Con; z.typ := OPT.linttyp; z.offset := elemSize; MulOrShift(y, z, t);
  868.                 IF basedRes THEN ReduceIndex(x, y.reg, rt) ELSE x.mode := Indexed; x.offset := y.reg END
  869.             END
  870.         ELSE (* DynArr *)
  871.             IF (y.mode = Con) & (y.offset = 0) THEN Field(x, 0, rt)
  872.             ELSE
  873.                 IF x.mode = Indexed THEN ReduceIndex(x, x.offset, -1); x.mode := Based; x.offset := 0 END;
  874.                 basedRes := x.offset # 0;
  875.                 IF inxchk IN options THEN
  876.                     v := y; IF (v.mode # Con) OR (v.offset >= 7FFFH) THEN Load(v, -1); MakeReg(v, -1) END;
  877.                     mode := x.dmode; z.mode := mode; z.typ := OPT.linttyp;
  878.                     IF mode = Reg THEN z.reg := x.dreg+x.typ^.offset DIV 4
  879.                     ELSE z.reg := x.dreg; z.offset := x.adr+x.typ^.offset; Load(z, -1)
  880.                     END;
  881.                     IF v.mode = Con THEN OPL.SetTrap(IndexCheck); OPL.Put(iTI+tULE*fTO+z.reg*fRA+v.offset)
  882.                     ELSE OPL.SetTrap(IndexCheck); OPL.Put(iT+tUGE*fTO+v.reg*fRA+z.reg*fRB)
  883.                     END;
  884.                     OPL.FreeTempR(z.reg);
  885.                     IF (y.mode # Reg) & (v.mode = Reg) THEN
  886.                         IF (y.mode = Con) & (SYSTEM.VAL(SET, y.offset)*SYSTEM.VAL(SET, y.offset-1) = {}) THEN
  887.                             OPL.FreeTempR(v.reg)
  888.                         ELSE y.mode := Reg; y.reg := v.reg
  889.                         END
  890.                     END
  891.                 END;
  892.                 v := x; TypeSize(v, v.typ^.BaseTyp, -1); ASSERT(x.mode = Based);
  893.                 v.dreg := -1;
  894.                 IF v.mode = Con THEN
  895.                     IF y.mode = Con THEN y.offset := y.offset*v.offset ELSE MulOrShift(y, v, -1) END
  896.                 ELSE
  897.                     IF y.mode = Con THEN MulOrShift(v, y, -1); y := v ELSE Times(y, v, -1) END
  898.                 END;
  899.                 IF ~(y.mode IN {Con, Reg}) THEN Load(y, -1); MakeReg(y, -1) END;
  900.                 IF basedRes THEN
  901.                     IF y.mode = Con THEN INC(x.offset, y.offset) ELSE ReduceIndex(x, y.reg, rt) END
  902.                 ELSE
  903.                     IF y.mode = Con THEN x.offset := y.offset ELSE x.mode := Indexed; x.offset := y.reg END
  904.                 END
  905.             END
  906.         END
  907.     END Index;
  908.     PROCEDURE Deref* (VAR x: OPL.Item; rt: LONGINT);
  909.         VAR btyp: OPT.Struct;
  910.     BEGIN
  911.         ASSERT(x.typ.form = Pointer);
  912.         Load(x, rt);
  913.         x.mode := Based; x.offset := 0;
  914.         btyp := x.typ.BaseTyp;
  915.         IF btyp.comp = Array THEN
  916.             REPEAT btyp := btyp.BaseTyp UNTIL btyp.comp # Array;
  917.             IF (btyp.comp = Record) OR (btyp.form = Pointer) THEN x.offset := 16 END
  918.         END;
  919.         IF nilchk  IN options THEN OPL.SetTrap(NilTrap); OPL.Put(iTI+tSLE*fTO+x.reg*fRA) END  (* tSLE statt tEQ *)
  920. (*        IF nilchk IN options THEN OPL.SetTrap(NilTrap); OPL.Put(iTI+tEQ*fTO+x.reg*fRA) END *)
  921.     END Deref;
  922.     PROCEDURE DynArrItem* (VAR x: OPL.Item; rt: LONGINT);
  923.         VAR dreg, doff, nofdim: LONGINT; typ: OPT.Struct; wasVar: BOOLEAN;
  924.     BEGIN
  925.         IF x.dmode IN {Reg, Var, VarPar} THEN    (* normal dynamic arrays *)    (* << mmb 15.11.91, temp fix for DynArr *)
  926.             IF x.mode = Reg THEN
  927.                 x.dreg := SHORT(SHORT(x.reg)); x.mode := Based; x.offset := 0
  928.             ELSE
  929.                 Base(x, -1); dreg := x.dreg;
  930.                 IF dreg = rt THEN
  931.                     dreg := OPL.GetTempR(); MoveReg(dreg, rt)
  932.                 END;
  933.                 x.dreg := SHORT(SHORT(dreg));
  934.             END        
  935.         ELSE
  936.             wasVar := x.mode IN {Var, VarPar};
  937.             IF x.mode = VarPar THEN x.mode := Var END;
  938.             Base(x, -1); dreg := x.reg;
  939.             IF wasVar THEN
  940.                 doff := x.offset; x.typ := OPT.linttyp; Load(x, rt); x.mode := Based; x.offset := 0
  941.             ELSE
  942.                 doff := 8;
  943.                 nofdim := 0; typ := x.typ; REPEAT INC(nofdim); typ := typ^.BaseTyp UNTIL typ^.comp # DynArr;
  944.                 ASSERT(x.offset = 0);
  945.                 x.offset := (nofdim DIV 2)*8+16
  946.             END;
  947.             x.dmode := Based; x.dreg := SHORT(SHORT(dreg)); OPL.HoldTempR(dreg); x.adr := doff
  948.         END
  949.     END DynArrItem;
  950.     PROCEDURE^ Compare* (VAR x, y: OPL.Item; subcl: INTEGER);
  951.     PROCEDURE TypTest* (VAR x: OPL.Item; typ: OPT.Struct; guard, equal, varrec: BOOLEAN);
  952.         VAR y, z: OPL.Item; h1, h2: LONGINT;
  953.     BEGIN
  954.         ASSERT(x.typ^.form = typ^.form);
  955.         IF ~guard OR (typchk IN options) THEN
  956.             IF guard THEN
  957.                 h1 := -1; h2 := -1; z := x;
  958.                 IF z.mode IN {Reg, RegSI, Based, Indexed} THEN h1 := z.reg; OPL.HoldTempR(h1) END;
  959.                 IF z.mode = Indexed THEN h2 := z.offset; OPL.HoldTempR(h2) END
  960.             END;
  961.             IF ~varrec THEN
  962.                 IF typ^.form = Pointer THEN Load(x, -1); x.mode := Based; x.offset := -4
  963.                 ELSE Base(x, -1); DEC(x.offset, 4)
  964.                 END;
  965.                 x.typ := OPT.linttyp; Load(x, -1);
  966.                 IF typ^.form = Pointer THEN typ := typ^.BaseTyp END
  967.             ELSE (* VarPar *)
  968.                 IF x.mode = Based THEN
  969.                     INC(x.reg); x.mode := Reg; x.typ := OPT.linttyp
  970.                  ELSE
  971.                     x.reg := FindFP(OPL.level, x.mnolev, -1); x.mode := Based; x.typ := OPT.linttyp; INC(x.offset, 4); Load(x, -1)
  972.                 END
  973.             END;
  974.             y.mode := Var; y.mnolev := -typ^.mno; y.offset := typ^.tdadr; y.dreg := -1; y.typ := OPT.linttyp; Load(y, -1);
  975.             IF ~equal THEN x.mode := Based; x.offset := -8-typ^.extlev*4; Load(x, -1) END;
  976.             IF guard THEN
  977.                 OPL.SetTrap(TypeGuard); OPL.FreeTempR(x.reg); OPL.FreeTempR(y.reg);
  978.                 OPL.Put(iT+tNEQ*fTO+x.reg*fRA+y.reg*fRB); x := z;
  979.                 IF h1 >= 0 THEN OPL.UnholdTempR(h1) END;
  980.                 IF h2 >= 0 THEN OPL.UnholdTempR(h2) END
  981.             ELSE
  982.                 Compare(x, y, eql)
  983.             END
  984.         END
  985.     END TypTest;
  986.     PROCEDURE RealUnary (op: LONGINT; VAR x: OPL.Item; rt: LONGINT);
  987.         VAR s: LONGINT;
  988.     BEGIN
  989.         Load(x, -1); s := x.reg; OPL.FreeTempF(s); rt := CheckF(rt); OPL.Put(op+rt*fFRT+s*fFRB); x.reg := rt
  990.     END RealUnary;
  991.     PROCEDURE FAddOp (op: LONGINT; VAR x, y: OPL.Item; rt: LONGINT);
  992.         VAR s1, s2: LONGINT;
  993.     BEGIN
  994.         Load(x, -1); Load(y, -1); s1 := x.reg; s2 := y.reg; OPL.FreeTempF(s1); OPL.FreeTempF(s2); rt := CheckF(rt);
  995.         OPL.Put(op+rt*fFRT+s1*fFRA+s2*fFRB); x.reg := rt
  996.     END FAddOp;
  997.     PROCEDURE FMulOp (op: LONGINT; VAR x, y: OPL.Item; rt: LONGINT);
  998.         VAR s1, s2: LONGINT;
  999.     BEGIN
  1000.         Load(x, -1); Load(y, -1); s1 := x.reg; s2 := y.reg; OPL.FreeTempF(s1); OPL.FreeTempF(s2); rt := CheckF(rt);
  1001.         OPL.Put(op+rt*fFRT+s1*fFRA+s2*fFRC); x.reg := rt
  1002.     END FMulOp;
  1003.     PROCEDURE FMulAddOp (op: LONGINT; VAR x, y, z: OPL.Item; rt: LONGINT);
  1004.         VAR s1, s2, s3: LONGINT;
  1005.     BEGIN
  1006.         Load(x, -1); Load(y, -1); Load(z, -1); s1 := x.reg; s2 := y.reg; s3 := z.reg;
  1007.         OPL.FreeTempF(s1); OPL.FreeTempF(s2); OPL.FreeTempF(s3); rt := CheckF(rt);
  1008.         OPL.Put(op+rt*fFRT+s1*fFRA+s2*fFRC+s3*fFRB); x.reg := rt
  1009.     END FMulAddOp;
  1010.     PROCEDURE IntUnary (op: LONGINT; VAR x: OPL.Item; rt: LONGINT);
  1011.         VAR s: LONGINT;
  1012.     BEGIN
  1013.         Load(x, -1); MakeReg(x, -1); s := x.reg; OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(op+rt*fRT+s*fRA); x.reg := rt
  1014.     END IntUnary;
  1015.     PROCEDURE IntBinary (op: LONGINT; VAR x, y: OPL.Item; rt: LONGINT);
  1016.         VAR s1, s2: LONGINT;
  1017.     BEGIN
  1018.         Load(x, -1); MakeReg(x, -1); Load(y, -1); MakeReg(y, -1); s1 := x.reg; s2 := y.reg;
  1019.         OPL.FreeTempR(s1); OPL.FreeTempR(s2); rt := CheckR(rt); OPL.Put(op+rt*fRT+s1*fRA+s2*fRB); x.reg := rt
  1020.     END IntBinary;
  1021.     PROCEDURE IntAddImm (VAR x, y: OPL.Item; rt: LONGINT);
  1022.         VAR s, t, l, u: LONGINT;
  1023.     BEGIN
  1024.         ASSERT(y.mode = Con);
  1025.         Load(x, -1); MakeReg(x, -1); s := x.reg; OPL.FreeTempR(s);
  1026.         u := y.offset; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  1027.         IF u = 0 THEN rt := CheckR(rt); OPL.Put(iAI+rt*fRT+s*fRA+l)
  1028.         ELSIF l = 0 THEN rt := CheckR(rt); OPL.Put(iCAU+rt*fRT+s*fRA+u)
  1029.         ELSE t := OPL.GetTempR(); OPL.FreeTempR(t); OPL.Put(iCAU+t*fRT+s*fRA+u);
  1030.             rt := CheckR(rt); OPL.Put(iCAL+rt*fRT+t*fRA+l)
  1031.         END;
  1032.         x.reg := rt
  1033.     END IntAddImm;
  1034.     PROCEDURE IntSubImm (VAR x, y: OPL.Item; rt: LONGINT);    (* x := x-y *)
  1035.         VAR s, u, l: LONGINT;
  1036.     BEGIN
  1037.         ASSERT(x.mode = Con);
  1038.         u := x.offset; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  1039.         IF u # 0 THEN IntBinary(iSF, y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1040.         ELSE Load(y, -1); MakeReg(y, -1); s := y.reg; OPL.FreeTempR(s); rt := CheckR(rt);
  1041.             OPL.Put(iSFI+rt*fRT+s*fRA+l); x.mode := Reg; x.reg := rt
  1042.         END
  1043.     END IntSubImm;
  1044.     PROCEDURE IntMulImm (VAR x, y: OPL.Item; rt: LONGINT);
  1045.         VAR s, u, l: LONGINT;
  1046.     BEGIN
  1047.         ASSERT(y.mode = Con);
  1048.         u := y.offset; l := u MOD LowWord; u := (SYSTEM.LSH(u, -16)+SYSTEM.LSH(l, -15)) MOD LowWord;
  1049.         IF u # 0 THEN IntBinary(iMULS, x, y, rt)
  1050.         ELSE Load(x, -1); MakeReg(x, -1); s := x.reg; OPL.FreeTempR(s); rt := CheckR(rt);
  1051.             OPL.Put(iMULI+rt*fRT+s*fRA+l); x.reg := rt
  1052.         END
  1053.     END IntMulImm;
  1054.     PROCEDURE IntCmp (VAR x, y: OPL.Item): LONGINT;
  1055.         VAR s1, s2, f: LONGINT;
  1056.     BEGIN
  1057.         Load(x, -1); MakeReg(x, -1); Load(y, -1); MakeReg(y, -1); s1 := x.reg; s2 := y.reg;
  1058.         OPL.FreeTempR(s1); OPL.FreeTempR(s2); f := OPL.GetTempCRF(); OPL.Put(iCMP+f*fBF+s1*fRA+s2*fRB);
  1059.         RETURN f
  1060.     END IntCmp;
  1061.     PROCEDURE IntCmpImm (VAR x, y: OPL.Item): LONGINT;
  1062.         VAR s1, s2, f: LONGINT;
  1063.     BEGIN
  1064.         ASSERT(y.mode = Con);
  1065.         s2 := y.offset;
  1066.         IF (-32767 < s2) & (s2 < 32768) THEN
  1067.             Load(x, -1); MakeReg(x, -1); s1 := x.reg; OPL.FreeTempR(s1); f := OPL.GetTempCRF();
  1068.             OPL.Put(iCMPI+f*fBF+s1*fRA+(s2 MOD LowWord)); RETURN f
  1069.         ELSE RETURN IntCmp(x, y)
  1070.         END
  1071.     END IntCmpImm;
  1072.     PROCEDURE SetBinary (op: LONGINT; VAR x, y: OPL.Item; rt: LONGINT);
  1073.         VAR s1, s2: LONGINT;
  1074.     BEGIN
  1075.         Load(x, -1); Load(y, -1); s1 := x.reg; s2 := y.reg; x.mode := Reg;
  1076.         OPL.FreeTempR(s1); OPL.FreeTempR(s2); rt := CheckR(rt); OPL.Put(op+rt*fRA+s1*fRS+s2*fRB); x.reg := rt
  1077.     END SetBinary;
  1078.     PROCEDURE SetInterImm (VAR x, y: OPL.Item; rt: LONGINT);
  1079.         VAR u, l, s, f: LONGINT;
  1080.     BEGIN
  1081.         u := y.offset; l := u MOD LowWord; u := SYSTEM.LSH(u, -16); Load(x, -1); s := x.reg; f := OPL.GetCRF0();
  1082.         IF (u = 0) & (f = 0) THEN OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(iANDIL+rt*fRA+s*fRS+l); x.reg := rt
  1083.         ELSIF (l = 0) & (f = 0) THEN OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(iANDIU+rt*fRA+s*fRS+u); x.reg := rt
  1084.         ELSE SetBinary(iAND, x, y, rt)
  1085.         END;
  1086.         f := f*4; OPL.FreeTempCRBs({f..f+3})
  1087.         (* here, an additional optimization can be made that uses the RLINM instruction for contiguous masks *)
  1088.     END SetInterImm;
  1089.     PROCEDURE SetSymImm (iop: LONGINT; VAR x, y: OPL.Item; rt: LONGINT);
  1090.         VAR u, l, s, t: LONGINT;
  1091.     BEGIN
  1092.         ASSERT(y.mode = Con);
  1093.         u := y.offset; l := u MOD LowWord; u := SYSTEM.LSH(u, -16);
  1094.         Load(x, -1); MakeReg(x, -1); s := x.reg; OPL.FreeTempR(s); 
  1095.         IF u = 0 THEN rt := CheckR(rt); OPL.Put(iop+rt*fRA+s*fRS+l)
  1096.         ELSE
  1097.             IF l # 0 THEN t := OPL.GetTempR(); OPL.FreeTempR(t); OPL.Put(iop+t*fRA+s*fRS+l); s := t END;
  1098.             rt := CheckR(rt); OPL.Put(iop+iUPPER+rt*fRA+s*fRS+u)
  1099.         END;
  1100.         x.reg := rt
  1101.     END SetSymImm;
  1102.     PROCEDURE SetRange* (VAR x, y: OPL.Item; rt: LONGINT);
  1103.         VAR s1, s2: LONGINT;
  1104.     BEGIN
  1105.         Load(x, -1); Load(y, -1); s1 := x.reg; s2 := y.reg; OPL.FreeTempR(s1); OPL.FreeTempR(s2);
  1106.         rt := CheckR(rt); OPL.Put(iMASKG+rt*fRA+s1*fRS+s2*fRB); x.reg := rt
  1107.     END SetRange;
  1108.     PROCEDURE SetElem* (VAR x: OPL.Item; rt: LONGINT);
  1109.         VAR s: LONGINT;
  1110.     BEGIN
  1111.         Load(x, -1); s := x.reg; OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(iMASKG+rt*fRA+s*fRS+s*fRB); x.reg := rt
  1112.     END SetElem;
  1113.     PROCEDURE Not* (VAR x: OPL.Item; rt: LONGINT);
  1114.         VAR s: LONGINT; l: OPL.Label;
  1115.     BEGIN
  1116.         l := x.Tjmp; x.Tjmp := x.Fjmp; x.Fjmp := l;
  1117.         IF x.mode = Cond THEN x.reg := -1-x.reg
  1118.         ELSE Load(x, -1); s := x.reg; OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(iSFI+rt*fRT+s*fRA+1); x.reg := rt
  1119.         END
  1120.     END Not;
  1121.     PROCEDURE Neg* (VAR x: OPL.Item; rt: LONGINT);
  1122.     BEGIN
  1123.         CASE x.typ^.form OF
  1124.             SInt, Int, LInt: IntUnary(iNEG, x, rt)
  1125.         |  Real, LReal: RealUnary(iFNEG, x, rt)
  1126.         |  Set: 
  1127.                 IF x.mode = RegSI THEN x.mode := Reg END;
  1128.                 IntUnary(iNOT, x, rt)
  1129.         END
  1130.     END Neg;
  1131.     PROCEDURE Abs* (VAR x: OPL.Item; rt: LONGINT);
  1132.         VAR s, t0, t1: LONGINT;
  1133.     BEGIN
  1134.         CASE x.typ^.form OF
  1135.             SInt, Int, LInt:
  1136.                 IF powerpc IN options THEN
  1137.                     Load(x, -1); MakeReg(x, -1);
  1138.                     s := x.reg; t0 := OPL.GetTempR();
  1139.                     OPL.Put(iSRAI+t0*fRA+s*fRS+24*fSH);
  1140.                     OPL.FreeTempR(s); t1 := OPL.GetTempR();
  1141.                     OPL.Put(iXOR+t1*fRA+t0*fRS+s*fRB);
  1142.                     OPL.FreeTempR(t0); OPL.FreeTempR(t1);
  1143.                     rt := CheckR(rt);
  1144.                     OPL.Put(iSF+rt*fRT+t0*fRA+t1*fRB);
  1145.                     x.reg := rt
  1146.                 ELSE
  1147.                     IntUnary(iABS, x, rt)
  1148.                 END
  1149.         |  Real, LReal: RealUnary(iFABS, x, rt)
  1150.         END
  1151.     END Abs;
  1152.     PROCEDURE Cap* (VAR x: OPL.Item; rt: LONGINT);
  1153.     BEGIN SetInterImm(x, CAPmask, rt)
  1154.     END Cap;
  1155.     PROCEDURE VarShift (rop: LONGINT; VAR x, y: OPL.Item; rt: LONGINT): LONGINT;
  1156.         VAR s1, s2, t: LONGINT; l: OPL.Label;
  1157.     BEGIN
  1158.         ASSERT(x.mode = Reg);
  1159.         s1 := x.reg; Load(y, -1); MakeReg(y, -1); s2 := y.reg; y.Fjmp := 0;
  1160.         Compare(y, zero, lss); OPL.FreeTempR(s1); OPL.FreeTempR(s2); PutCondBranch(y, FALSE);
  1161.         t := OPL.GetTempR(); OPL.FreeTempR(t); rt := CheckR(rt); OPL.Put(iABS+t*fRT+s2*fRA);
  1162.         OPL.Put(rop+rt*fRA+s1*fRS+t*fRB); l := 0; PutBranch(l); SetLabel(y.Fjmp);
  1163.         OPL.Put(iSL+rt*fRA+s1*fRS+s2*fRB); SetLabel(l);
  1164.         RETURN rt
  1165.     END VarShift;
  1166.     PROCEDURE Ash* (VAR x, y: OPL.Item; rt: LONGINT);
  1167.         VAR sh, s, t: LONGINT;
  1168.     BEGIN
  1169.         Load(x, -1);
  1170.         IF y.mode = Con THEN
  1171.             sh := y.offset; s := x.reg; OPL.FreeTempR(s);
  1172.             IF x.mode = RegSI THEN
  1173.                 IF sh >= 24 THEN
  1174.                     sh := sh MOD 32; rt := CheckR(rt); OPL.Put(iRLINM+rt*fRA+s*fRS+sh*fSH+(31-sh)*fME)
  1175.                 ELSE
  1176.                     sh := IMIN(24-sh, 31); t := OPL.GetTempR(); OPL.FreeTempR(t);
  1177.                     OPL.Put(iRLINM+t*fRA+s*fRS+24*fSH+8*fME); rt := CheckR(rt); OPL.Put(iSRAI+rt*fRA+t*fRS+sh*fSH)
  1178.                 END;
  1179.                 x.mode := Reg
  1180.             ELSE rt := CheckR(rt);
  1181.                 IF sh < 0 THEN OPL.Put(iSRAI+rt*fRA+s*fRS+((-sh) MOD 32)*fSH)
  1182.                 ELSE sh := sh MOD 32; OPL.Put(iRLINM+rt*fRA+s*fRS+sh*fSH+(31-sh)*fME)
  1183.                 END
  1184.             END
  1185.         ELSE rt := VarShift(iSRA, x, y, rt)
  1186.         END;
  1187.         x.reg := rt
  1188.     END Ash;
  1189.     PROCEDURE Times* (VAR x, y: OPL.Item; rt: LONGINT);
  1190.     BEGIN
  1191.         CASE x.typ^.form OF
  1192.             SInt, Int, LInt:
  1193.                 IF x.mode = Con THEN IntMulImm(y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1194.                 ELSIF y.mode = Con THEN IntMulImm(x, y, rt)
  1195.                 ELSE IntBinary(iMULS, x, y, rt)
  1196.                 END
  1197.         |  Real:
  1198.                 IF powerpc IN options THEN FMulOp(iFMULS, x, y, rt) ELSE FMulOp(iFM, x, y, rt) END
  1199.         |  LReal: FMulOp(iFM, x, y, rt)
  1200.         |  Set:
  1201.                 IF x.mode = Con THEN SetInterImm(y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1202.                 ELSIF y.mode = Con THEN SetInterImm(x, y, rt)
  1203.                 ELSE SetBinary(iAND, x, y, rt)
  1204.                 END
  1205.         END;
  1206.     END Times;
  1207.     PROCEDURE Div* (VAR x, y: OPL.Item; rt: LONGINT);
  1208.         VAR s1, s2: LONGINT; z: OPL.Item; xoptb, xoptc, yopt: BOOLEAN;
  1209.     BEGIN
  1210.         ASSERT(x.typ^.form IN {SInt, Int, LInt});
  1211.         xoptb := x.mode = Con; yopt := y.mode = Con; xoptc := FALSE;
  1212.         IF xoptb THEN xoptc := x.offset >= 0 END;
  1213.         IF yopt & (y.offset <= 0) THEN OPM.err(301) END;
  1214.         Load(x, -1); MakeReg(x, -1); Load(y, -1); MakeReg(y, -1); s1 := x.reg; s2 := y.reg;
  1215.         OPL.FreeTempR(s1); OPL.FreeTempR(s2); rt := CheckR(rt);
  1216.         IF ~yopt THEN OPL.SetTrap(DivideTrap); OPL.Put(iTI+tSLE*fTO+s2*fRA) END;
  1217.         OPL.Put(iDIVS+rt*fRT+s1*fRA+s2*fRB+fREC);
  1218.         IF ~xoptb THEN z.mode := Cond; z.reg := -1-bLT; z.Tjmp := 0; PutCondBranch(z, TRUE) END;
  1219.         IF ~xoptc THEN OPL.Put(iAI+rt*fRT+rt*fRA+((-1) MOD LowWord)) END;
  1220.         IF ~xoptb THEN SetLabel(z.Tjmp) END;
  1221.         x.reg := rt
  1222.     END Div;
  1223.     PROCEDURE Slash* (VAR x, y: OPL.Item; rt: LONGINT);
  1224.     BEGIN
  1225.         CASE x.typ^.form OF
  1226.             Real:
  1227.                 IF powerpc IN options THEN FAddOp(iFDIVS, x, y, rt) ELSE FAddOp(iFD, x, y, rt) END
  1228.         |  LReal: FAddOp(iFD, x, y, rt)
  1229.         |  Set:
  1230.                 IF x.mode = Con THEN SetSymImm(iXORIL, y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1231.                 ELSIF y.mode = Con THEN SetSymImm(iXORIL, x, y, rt)
  1232.                 ELSE SetBinary(iXOR, x, y, rt)
  1233.                 END
  1234.         END
  1235.     END Slash;
  1236.     PROCEDURE Mod* (VAR x, y: OPL.Item; rt: LONGINT);
  1237.         VAR s1, s2, t, imm: LONGINT; z: OPL.Item; xoptb, xoptc, yopt, ysimm: BOOLEAN;
  1238.     BEGIN
  1239.         ASSERT(x.typ^.form IN {SInt, Int, LInt});
  1240.         xoptb := x.mode = Con; yopt := y.mode = Con; xoptc := FALSE; ysimm := FALSE;
  1241.         IF xoptb THEN xoptc := x.offset > 0 END;
  1242.         IF yopt THEN imm := y.offset;
  1243.             IF imm <= 0 THEN OPM.err(301) ELSE ysimm := imm < 32767 END
  1244.         END;
  1245.         Load(x, -1); MakeReg(x, -1); Load(y, -1); MakeReg(y, -1); s1 := x.reg; s2 := y.reg; OPL.FreeTempR(s1);
  1246.         IF ~yopt THEN OPL.SetTrap(DivideTrap); OPL.Put(iTI+tSLE*fTO+s2*fRA) END;
  1247.         OPL.Put(iDIVS+s1*fRA+s2*fRB+fREC); rt := CheckR(rt); OPL.FreeTempR(s2);
  1248.         IF ~xoptc & ~ysimm & (rt = s2) THEN
  1249.             t := OPL.GetTempR(); MoveReg(t, s2); s2 := t; OPL.FreeTempR(t)
  1250.         END;
  1251.         OPL.Put(iMFSPR+rt*fRT+spMQ*fSPR);
  1252.         IF ~xoptb THEN z.mode := Cond; z.reg := -1-bLT; z.Tjmp := 0; PutCondBranch(z, TRUE) END;
  1253.         IF ~xoptc THEN
  1254.             IF ysimm THEN OPL.Put(iAI+rt*fRT+rt*fRA+(imm MOD LowWord))
  1255.             ELSE OPL.Put(iA+rt*fRT+rt*fRA+s2*fRB)
  1256.             END
  1257.         END;
  1258.         IF ~xoptb THEN SetLabel(z.Tjmp) END;
  1259.         x.reg := rt
  1260.     END Mod;
  1261.     PROCEDURE Plus* (VAR x, y: OPL.Item; rt: LONGINT);
  1262.     BEGIN
  1263.         CASE x.typ^.form OF
  1264.             SInt, Int, LInt:
  1265.                 IF x.mode = Con THEN IntAddImm(y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1266.                 ELSIF y.mode = Con THEN IntAddImm(x, y, rt)
  1267.                 ELSE IntBinary(iCAX, x, y, rt)
  1268.                 END
  1269.         |  Real:
  1270.                 IF powerpc IN options THEN FAddOp(iFADDS, x, y, rt) ELSE FAddOp(iFA, x, y, rt) END
  1271.         |  LReal: FAddOp(iFA, x, y, rt)
  1272.         |  Set:
  1273.                 IF x.mode = Con THEN SetSymImm(iORIL, y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1274.                 ELSIF y.mode = Con THEN SetSymImm(iORIL, x, y, rt)
  1275.                 ELSE SetBinary(iOR, x, y, rt)
  1276.                 END
  1277.         END
  1278.     END Plus;
  1279.     PROCEDURE Minus* (VAR x, y: OPL.Item; rt: LONGINT);
  1280.     BEGIN
  1281.         CASE x.typ^.form OF
  1282.             SInt, Int, LInt:
  1283.                 IF x.mode = Con THEN IntSubImm(x, y, rt)
  1284.                 ELSIF y.mode = Con THEN y.offset := -y.offset; IntAddImm(x, y, rt)
  1285.                 ELSE IntBinary(iSF, y, x, rt); x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1286.                 END
  1287.         |  Real:
  1288.                 IF powerpc IN options THEN FAddOp(iFSUBS, x, y, rt) ELSE FAddOp(iFS, x, y, rt) END
  1289.         |  LReal: FAddOp(iFS, x, y, rt)
  1290.         |  Set:
  1291.                 IF y.mode = Con THEN y.offset := -1-y.offset; SetInterImm(x, y, rt)
  1292.                 (* if x.mode = Con, an optimization could be to translate to (-y) MASK x, if the number of masks is 1 in x *)
  1293.                 ELSE SetBinary(iANDC, x, y, rt)
  1294.                 END
  1295.         END
  1296.     END Minus;
  1297.     PROCEDURE MulAdd* (VAR x, y, z: OPL.Item; rt: LONGINT);
  1298.     BEGIN
  1299.         IF (powerpc IN options) & (x.typ^.form = Real) THEN FMulAddOp(iFMADDS, x, y, z, rt)
  1300.         ELSE FMulAddOp(iFMA, x, y, z, rt)
  1301.         END
  1302.     END MulAdd;
  1303.     PROCEDURE MulSub* (VAR x, y, z: OPL.Item; rt: LONGINT; invert: BOOLEAN);
  1304.     BEGIN
  1305.         IF (powerpc IN options) & (x.typ^.form = Real) THEN
  1306.             IF invert THEN FMulAddOp(iFNMSUBS, x, y, z, rt) ELSE FMulAddOp(iFMSUBS, x, y, z, rt) END
  1307.         ELSE
  1308.             IF invert THEN FMulAddOp(iFNMS, x, y, z, rt) ELSE FMulAddOp(iFMS, x, y, z, rt) END
  1309.         END
  1310.     END MulSub;
  1311.     PROCEDURE In* (VAR x, y: OPL.Item);
  1312.         VAR s1, s2, t, crf, ropt: LONGINT;
  1313.     BEGIN
  1314.         ASSERT((x.typ^.form IN {SInt, Int, LInt}) & (y.typ^.form = Set));
  1315.         Load(y, -1); IF y.mode = RegSI THEN y.mode := Reg END;
  1316.         s2 := y.reg;
  1317.         crf := OPL.GetCRF0();
  1318.         IF crf = 0 THEN ropt := fREC ELSE OPL.FreeTempCRBs({crf*4..crf*4+3}); ropt := 0 END;
  1319.         IF x.mode = Con THEN
  1320.             OPL.FreeTempR(s2); t := OPL.GetTempR();
  1321.             OPL.Put(iRLINM+t*fRA+s2*fRS+(x.offset MOD 32)*fSH+ropt)
  1322.         ELSE
  1323.             Load(x, -1); s1 := x.reg; OPL.FreeTempR(s1); OPL.FreeTempR(s2); t := OPL.GetTempR();
  1324.             OPL.Put(iRLNM+t*fRA+s2*fRS+s1*fRB+ropt)
  1325.         END;
  1326.         IF crf = 0 THEN
  1327.             x.mode := Cond; x.reg := -1-bEQ; OPL.FreeTempR(t)
  1328.         ELSE
  1329.             x.mode := Reg; x.reg := t
  1330.         END
  1331.     END In;
  1332.     PROCEDURE Odd* (VAR x: OPL.Item);
  1333.         VAR z: OPL.Item;
  1334.     BEGIN Load(x, -1); MakeReg(x, -1);
  1335.         z := zero; z.offset := 31; x.typ := OPT.settyp; In(z, x); x.mode := z.mode; x.reg := z.reg; x.offset := z.offset
  1336.     END Odd;
  1337.     PROCEDURE SYSaddr* (VAR x: OPL.Item; rt: LONGINT);
  1338.     BEGIN LoadAddr(x, rt)
  1339.     END SYSaddr;
  1340.     PROCEDURE SYSval* (VAR x: OPL.Item; sform, dform: INTEGER);
  1341.         VAR y: OPL.Item; adr: LONGINT;
  1342.     BEGIN
  1343.         IF x.mode = Cond THEN CondToReg(x, -1) END;
  1344.         IF (x.mode = Con) & (dform IN {Real, LReal}) THEN
  1345.             OPL.AllocConst(x.offset, 4, adr, 4);
  1346.             (* note: for LReal, the lower 32 bits are undefined *)
  1347.             x.mode := Based; x.reg := SB; x.offset := adr
  1348.         ELSIF (x.mode IN {Reg, FReg}) & ((sform IN {Real, LReal}) # (dform IN {Real, LReal})) THEN
  1349.             IF scratch < 0 THEN scratch := OPL.dsize; INC(OPL.dsize, 8) END;
  1350.             y.mode := Based; y.reg := SB; y.offset := scratch; y.typ := x.typ; y.dreg := -1; Store(y, x);
  1351.             x.mode := y.mode; x.reg := y.reg; x.offset := y.offset
  1352.         END
  1353.     END SYSval;
  1354.     PROCEDURE SYSlsh* (VAR x, y: OPL.Item; rt: LONGINT);
  1355.         VAR s1, s2: LONGINT;
  1356.     BEGIN
  1357.         Load(x, -1); MakeReg(x, -1); s1 := x.reg;
  1358.         (* the case where x.mode = RegSI may be optimized here *)
  1359.         IF y.mode = Con THEN
  1360.             s2 := y.offset; OPL.FreeTempR(s1); rt := CheckR(rt);
  1361.             IF x.typ.form = Set THEN s2 := -s2 END;
  1362.             IF s2 < 0 THEN OPL.Put(iRLINM+rt*fRA+s1*fRS+(s2 MOD 32)*fSH+(-s2)*fMB+31*fME)
  1363.             ELSE OPL.Put(iRLINM+rt*fRA+s1*fRS+(s2 MOD 32)*fSH+((31-s2) MOD 32)*fME)
  1364.             END
  1365.         ELSE
  1366.             IF x.typ.form = Set THEN Neg(y, -1) END;
  1367.             rt := VarShift(iSR, x, y, rt)
  1368.         END;
  1369.         x.reg := rt
  1370.     END SYSlsh;
  1371.     PROCEDURE SYSrot* (VAR x, y: OPL.Item; rt: LONGINT);
  1372.         VAR s, t, mb: LONGINT;
  1373.     BEGIN
  1374.         Load(x, -1);
  1375.         CASE x.typ^.form OF
  1376.             Byte, Char, SInt:
  1377.                 s := x.reg; OPL.Put(iRLIMI+s*fRA+s*fRS+8*fSH+16*fMB+23*fME);
  1378.                 OPL.Put(iRLIMI+s*fRA+s*fRS+16*fSH+15*fME); mb := 24
  1379.         |  Int:
  1380.                 MakeReg(x, -1); s := x.reg; OPL.Put(iRLIMI+s*fRA+s*fRS+16*fSH+15*fME); mb := 16
  1381.         |  LInt, Set:
  1382.                 MakeReg(x, -1); s := x.reg; mb := 0
  1383.         END;
  1384.         IF y.mode # Con THEN
  1385.             IF x.typ.form = Set THEN Neg(y, -1) END;
  1386.             Load(y, -1); OPL.FreeTempR(s); t := y.reg; OPL.FreeTempR(t); rt := CheckR(rt);
  1387.             OPL.Put(iRLNM+rt*fRA+s*fRS+t*fRB+mb*fMB+31*fME)
  1388.         ELSE
  1389.             t := y.offset; OPL.FreeTempR(s); rt := CheckR(rt);
  1390.             IF x.typ.form = Set THEN t := -t END;
  1391.             OPL.Put(iRLINM+rt*fRA+s*fRS+(t MOD 32)*fSH+mb*fMB+31*fME)
  1392.         END;
  1393.         x.reg := rt
  1394.     END SYSrot;
  1395.     PROCEDURE^ Assign* (VAR x, y: OPL.Item);
  1396.     PROCEDURE SYSget* (VAR x, z, y: OPL.Item);
  1397.     BEGIN
  1398.         Load(x, -1); MakeReg(x, -1);
  1399.         IF z.mode = Con THEN x.mode := Based; x.offset := z.offset
  1400.         ELSE Load(z, -1); MakeReg(z, -1); x.mode := Indexed; x.offset := z.reg
  1401.         END;
  1402.         x.typ := y.typ; Assign(y, x)
  1403.     END SYSget;
  1404.     PROCEDURE SYSput* (VAR x, z, y: OPL.Item);
  1405.     BEGIN
  1406.         Load(x, -1); MakeReg(x, -1);
  1407.         IF z.mode = Con THEN x.mode := Based; x.offset := z.offset
  1408.         ELSE Load(z, -1); MakeReg(z, -1); x.mode := Indexed; x.offset := z.reg
  1409.         END;
  1410.         x.typ := y.typ; Assign(x, y)
  1411.     END SYSput;
  1412.     PROCEDURE SYSgetreg* (VAR x, y: OPL.Item);
  1413.         VAR t, form: LONGINT; reg: BOOLEAN; z: OPL.Item;
  1414.     BEGIN
  1415.         ASSERT(y.mode = Con);
  1416.         IF y.offset < 32 THEN
  1417.             y.mode := Reg; y.reg := y.offset; y.typ := x.typ; Assign(x, y)
  1418.         ELSIF y.offset < 66 THEN
  1419.             IF x.typ^.form IN {LInt, Set} THEN
  1420.                 reg := x.mode = Reg;
  1421.                 IF reg THEN t := x.reg ELSE t := OPL.GetTempR() END;
  1422.                     IF y.offset = 64 THEN OPL.Put(iMFCR+t*fRT)
  1423.                     ELSIF y.offset = 65 THEN OPL.Put(iMFMSR+t*fRT)
  1424.                     ELSE OPL.Put(iMFSPR+t*fRT+(y.offset-32)*fSPR)
  1425.                     END;
  1426.                 IF ~reg THEN y.mode := Reg; y.reg := t; y.typ := x.typ; Assign(x, y) END
  1427.             ELSE OPM.err(250)
  1428.             END
  1429.         ELSE (* y.offset = 66 *)
  1430.             reg := x.mode = FReg;
  1431.             IF reg THEN t := x.reg ELSE t := OPL.GetTempF() END;
  1432.             OPL.Put(iMFFS+t*fFRT);
  1433.             IF ~reg THEN form := x.typ^.form;
  1434.                 IF form = LReal THEN
  1435.                     y.mode := FReg; y.reg := t; y.typ := x.typ; Assign(x, y)
  1436.                 ELSIF form IN {LInt, Set} THEN
  1437.                     IF scratch < 0 THEN scratch := OPL.dsize; INC(OPL.dsize, 8) END;
  1438.                     z.mode := Based; z.reg := SB; z.offset := scratch; z.typ := OPT.lrltyp; z.dreg := -1; Store(z, y);
  1439.                     z.mode := Based; z.offset := scratch+4; z.reg := SB; z.typ := x.typ; Assign(x, z)
  1440.                 END
  1441.             END
  1442.         END
  1443.     END SYSgetreg;
  1444.     PROCEDURE SYSputreg* (VAR x, y: OPL.Item);
  1445.         VAR z: OPL.Item;
  1446.     BEGIN
  1447.         ASSERT(x.mode = Con);
  1448.         IF x.offset < 32 THEN
  1449.             x.mode := Reg; x.reg := x.offset; x.typ := y.typ; Assign(x, y)
  1450.         ELSIF x.offset < 66 THEN
  1451.             IF y.typ^.form IN {LInt, Set} THEN
  1452.                 Load(y, -1);
  1453.                 IF x.offset = 64 THEN OPL.Put(iMTCRF+y.reg*fRS+255*fFXM)
  1454.                 ELSIF x.offset = 65 THEN OPL.Put(iMTMSR+y.reg*fRS)
  1455.                 ELSE OPL.Put(iMTSPR+y.reg*fRS+(x.offset-32)*fSPR)
  1456.                 END;
  1457.                 OPL.FreeTempR(y.reg)
  1458.             ELSE OPM.err(250)
  1459.             END
  1460.         ELSE (* x.offset = 66 *)
  1461.             IF y.typ^.form IN {LInt, Set} THEN
  1462.                 IF y.mode = Reg THEN
  1463.                     IF scratch < 0 THEN scratch := OPL.dsize; INC(OPL.dsize, 8) END;
  1464.                     z.mode := Based; z.reg := SB; z.offset := scratch+4; z.typ := y.typ; z.dreg := -1; Assign(z, y);
  1465.                     y.mode := Based; y.reg := SB; y.offset := scratch
  1466.                 ELSE Base(y, -1); DEC(y.offset, 4)
  1467.                 END;
  1468.                 y.typ := OPT.lrltyp
  1469.             END;
  1470.             Load(y, -1);
  1471.             OPL.Put(iMTFSF+255*fFLM+y.reg*fFRB); OPL.FreeTempF(y.reg)
  1472.         END
  1473.     END SYSputreg;
  1474.     PROCEDURE SYSmove* (VAR x, y, z: OPL.Item);
  1475.     BEGIN
  1476.         Load(x, -1); Load(y, -1); x.mode := Based; x.offset := 0; y.mode := Based; y.offset := 0; Move(x, y, z, FALSE)
  1477.     END SYSmove;
  1478.     PROCEDURE NewSys* (VAR x, y: OPL.Item; rt: LONGINT);
  1479.         VAR saved: OPL.SaveDesc;
  1480.     BEGIN
  1481.         x.mode := XProc; x.reg := 0; x.typ := OPT.notyp; x.dreg := -1; OPL.SaveRegisters(x, saved, sSize);
  1482.         x.mode := Reg; x.reg := 3; x.typ := OPT.linttyp; Assign(x, y);
  1483.         x.mode := XProc; x.mnolev := -SYSTEM.VAL(SHORTINT, SYSMTag);
  1484.         x.offset := ORD(NewSysETag); x.adr := NewSysEntry;
  1485.         OPL.Put(iL+SB*fRT+SB*fRA+(OPL.linkTable MOD LowWord)); OPL.PutXCall(x);
  1486.         NewSysEntry := x.adr; OPL.Put(iL+SB*fRT+SP*fRA+20);
  1487.         x.mode := Reg; x.reg := 3; x.typ := OPT.linttyp; OPL.RestoreRegisters(x, saved, rt)
  1488.     END NewSys;
  1489.     PROCEDURE NewArr* (VAR x, nofel: OPL.Item; nofdim: LONGINT; typ: OPT.Struct; rt: LONGINT);
  1490.         VAR y: OPL.Item; saved: OPL.SaveDesc;
  1491.     BEGIN
  1492.         OPL.FreePar;
  1493.         IF (typ^.form # Pointer) & (typ^.tdadr > -3) THEN (* simple type *)
  1494.             y.mode := Con; y.offset := typ^.size; y.typ := OPT.linttyp; y.dreg := -1; OPL.LockParR(3); MulOrShift(nofel, y, 3);
  1495.             IF nofel.mode = Con THEN INC(nofel.offset, (nofdim DIV 2)*8+16)
  1496.             ELSE y.mode := Con; y.typ := OPT.linttyp; y.offset := (nofdim DIV 2)*8+16;
  1497.                 Load(nofel, -1); IntAddImm(nofel, y, 3)
  1498.             END;
  1499.             OPL.FreePar; NewSys(x, nofel, rt)
  1500.         ELSE
  1501.             x.mode := XProc; x.reg := 0; x.typ := OPT.notyp; x.dreg := -1;
  1502.             OPL.SaveRegisters(x, saved, sSize);
  1503.             x.mode := Reg; x.typ := OPT.linttyp;
  1504.             x.reg := 4; OPL.LockParR(4); Assign(x, nofel);
  1505.             x.reg := 5; OPL.LockParR(5); y.mode := Con; y.offset := nofdim; y.typ := OPT.linttyp; Assign(x, y);
  1506.             x.reg := 3; OPL.LockParR(3);
  1507.             IF typ^.form = Pointer THEN y.mode := Con; y.offset := 0; y.typ := OPT.linttyp
  1508.             ELSE y.mode := Var; y.mnolev := -typ^.mno; y.offset := typ^.tdadr; y.typ := OPT.linttyp
  1509.             END;
  1510.             Assign(x, y); OPL.FreePar;
  1511.             x.mode := XProc; x.mnolev := -SYSTEM.VAL(SHORTINT, SYSMTag);
  1512.             x.offset := ORD(NewArrETag); x.adr := NewArrEntry;
  1513.             OPL.Put(iL+SB*fRT+SB*fRA+(OPL.linkTable MOD LowWord)); OPL.PutXCall(x);
  1514.             NewArrEntry := x.adr; OPL.Put(iL+SB*fRT+SP*fRA+20);
  1515.             x.mode := Reg; x.reg := 3; x.typ := OPT.linttyp; OPL.RestoreRegisters(x, saved, rt)
  1516.         END
  1517.     END NewArr;
  1518.     PROCEDURE NewRec* (VAR x: OPL.Item; typ: OPT.Struct; rt: LONGINT);
  1519.         VAR y: OPL.Item; saved: OPL.SaveDesc; len: LONGINT; btyp: OPT.Struct;
  1520.     BEGIN
  1521.         IF typ^.tdadr > -3 THEN (* no type descriptor allocated *)
  1522.             IF typ^.comp = Array THEN len := typ^.n; btyp := typ^.BaseTyp;
  1523.                 WHILE btyp^.comp = Array DO len := len*btyp^.n; btyp := btyp^.BaseTyp END;
  1524.                 y.mode := Con; y.typ := OPT.linttyp;
  1525.                 IF (btyp^.comp = Record) OR (btyp^.form = Pointer) THEN y.offset := len; NewArr(x, y, 1, btyp, rt)
  1526.                 ELSE y.offset := typ^.size; NewSys(x, y, rt)
  1527.                 END
  1528.             ELSE
  1529.                 y.mode := Con; y.offset := typ^.size; y.typ := OPT.linttyp; NewSys(x, y, rt)
  1530.             END
  1531.         ELSE
  1532.             x.mode := XProc; x.reg := 0; x.typ := OPT.notyp; x.dreg := -1; OPL.SaveRegisters(x, saved, sSize);
  1533.             y.mode := Var; y.mnolev := -typ^.mno; y.offset := typ^.tdadr; y.typ := OPT.linttyp;
  1534.             x.mode := Reg; x.reg := 3; x.typ := OPT.linttyp; Assign(x, y);
  1535.             x.mode := XProc; x.mnolev := -SYSTEM.VAL(SHORTINT, SYSMTag);
  1536.             x.offset := ORD(NewRecETag); x.adr := NewRecEntry;
  1537.             OPL.Put(iL+SB*fRT+SB*fRA+(OPL.linkTable MOD LowWord)); OPL.PutXCall(x);
  1538.             NewRecEntry := x.adr; OPL.Put(iL+SB*fRT+SP*fRA+20);
  1539.             x.mode := Reg; x.reg := 3; x.typ := OPT.linttyp; OPL.RestoreRegisters(x, saved, rt)
  1540.         END
  1541.     END NewRec;
  1542.     PROCEDURE SetDim* (VAR y, len: OPL.Item; typ: OPT.Struct);
  1543.         VAR z: OPL.Item;
  1544.     BEGIN
  1545.         z := y; INC(z.offset, typ^.offset); OPL.UnholdTempR(len.reg); Assign(z, len)
  1546.     END SetDim;
  1547.     PROCEDURE ArrayLen (VAR x: OPL.Item; rt: LONGINT);
  1548.         VAR typ: OPT.Struct;
  1549.     BEGIN
  1550.         typ := x.typ;
  1551.         IF typ^.comp = Array THEN
  1552.             x.mode := Con; x.offset := typ^.n
  1553.         ELSE ASSERT(typ^.comp = DynArr);
  1554.             IF x.dmode = Reg THEN x.mode := Reg; x.reg := x.dreg + typ^.offset DIV 4
  1555.             ELSE ASSERT(x.dmode = Based);
  1556.                 x.mode := Based; x.reg := x.dreg; x.offset := x.adr + typ^.offset
  1557.             END
  1558.         END;
  1559.         x.typ := OPT.linttyp
  1560.     END ArrayLen;
  1561.     PROCEDURE PPCcopy (VAR x, y: OPL.Item);    (* copy y to x, PowerPC sequence *)
  1562.         VAR z: OPL.Item; t0, t1, src, dest, cond, h: LONGINT; loop, end0, end1, end: OPL.Label;
  1563.     BEGIN
  1564.         Base(x, -1); ShortBase(x, -1);
  1565.         Base(y, -1); ShortBase(y, -1); OPL.UnholdTempR(y.dreg);
  1566.         z := x; ArrayLen(z, -1);
  1567.         t0 := OPL.GetTempR(); t1 := OPL.GetTempR(); cond := OPL.GetTempCRF();
  1568.         Load(z, -1); OPL.FreeTempR(z.reg); OPL.Put(iMTSPR+z.reg*fRS+spCTR*fSPR);
  1569.         dest := x.reg; src := y.reg;
  1570.         IF ~(dest IN OPL.TempRegs) THEN
  1571.             h := OPL.GetTempR(); OPL.Put(iCAL+h*fRT+dest*fRA+(x.offset MOD LowWord)); x.offset := 0; dest := h
  1572.         END;
  1573.         IF ~(src IN OPL.TempRegs) THEN
  1574.             h := OPL.GetTempR(); OPL.Put(iCAL+h*fRT+src*fRA+(y.offset MOD LowWord)); y.offset := 0; src := h
  1575.         END;
  1576.         end0 := 0; end1 := 0; end := 0; loop := 0;
  1577.         IF y.offset # 0 THEN OPL.Put(iLBZU+t0*fRT+src*fRA+(y.offset MOD LowWord)) ELSE OPL.Put(iLBZ+t0*fRT+src*fRA) END;
  1578.         OPL.Put(iCAL);
  1579.         PutBranchInstr(iBDZ, end0);
  1580.         OPL.Put(iCMPI+cond*fBF+t0*fRA+0);
  1581.         PutBranchInstr(iBT+(cond*4+bEQ)*fBI, end0);
  1582.         OPL.Put(iLBZU+t1*fRT+src*fRA+1);
  1583.         IF x.offset # 0 THEN OPL.Put(iSTBU+t0*fRS+dest*fRA+(x.offset MOD LowWord)) ELSE OPL.Put(iSTB+t0*fRS+dest*fRA) END;
  1584.         PutBranchInstr(iBDZ, end1);
  1585.         OPL.Put(iCMPI+cond*fBF+t1*fRA+0);
  1586.         PutBranchInstr(iBT+(cond*4+bEQ)*fBI, end1);
  1587.         SetLabel(loop);
  1588.         OPL.Put(iLBZU+t0*fRT+src*fRA+1);
  1589.         OPL.Put(iSTBU+t1*fRS+dest*fRA+1);
  1590.         PutBranchInstr(iBDZ, end1);
  1591.         OPL.Put(iCMPI+cond*fBF+t0*fRA+0);
  1592.         PutBranchInstr(iBT+(cond*4+bEQ)*fBI, end1);
  1593.         OPL.Put(iLBZU+t1*fRT+src*fRA+1);
  1594.         OPL.Put(iSTBU+t0*fRS+dest*fRA+1);
  1595.         PutBranchInstr(iBDZ, end1);
  1596.         OPL.Put(iCMPI+cond*fBF+t0*fRA+0);
  1597.         PutBranchInstr(iBF+(cond*4+bEQ)*fBI, loop);
  1598.         SetLabel(end1);
  1599.         OPL.Put(iSTB+0*fRS+dest*fRA+1);
  1600.         PutBranch(end);
  1601.         SetLabel(end0);
  1602.         OPL.Put(iSTB+0*fRS+dest*fRA+(x.offset MOD LowWord));
  1603.         SetLabel(end);
  1604.         OPL.FreeTempR(t0); OPL.FreeTempR(t1); OPL.FreeTempR(src); OPL.FreeTempR(dest); OPL.FreeTempCRBs({cond*4..cond*4+3})
  1605.     END PPCcopy;
  1606.     PROCEDURE POWERcopy (VAR x, y: OPL.Item);    (* copy y to x, POWER sequence *)
  1607.         VAR len, a, b: OPL.Item;
  1608.             first, cnt, src, dest, lreg: LONGINT; used: SET;
  1609.             styp, dtyp: OPT.Struct;
  1610.             restOnly, noLoop, noLenChk: BOOLEAN;
  1611.             end, rest, loop: OPL.Label;
  1612.     BEGIN
  1613.         styp := y.typ; dtyp := x.typ;
  1614.         IF x.mode = Based THEN used := {x.reg} ELSE used := {x.reg, x.offset} END;
  1615.         first := 3;
  1616.         WHILE first IN used DO INC(first) END;
  1617.         LoadAddr(y, first);
  1618.         IF y.reg = first THEN INCL(used, first)
  1619.         ELSIF y.reg IN OPL.TempRegs THEN MoveReg(first, y.reg); OPL.FreeTempR(y.reg); y.reg := first; INCL(used, first)
  1620.         END;
  1621.         IF dtyp^.comp = Array THEN
  1622.             IF x.mode = Based THEN EXCL(used, x.reg) ELSE used := used - {x.reg, x.offset} END
  1623.         END;
  1624.         first := 3;
  1625.         WHILE first IN used DO INC(first) END;
  1626.         len := x; lreg := -1;
  1627.         LoadAddr(x, first);
  1628.         IF x.mode = Based THEN EXCL(used, x.reg) ELSE used := used - {x.reg, x.offset} END;
  1629.         IF x.reg = first THEN INCL(used, first)
  1630.         ELSIF x.reg IN OPL.TempRegs THEN MoveReg(first, x.reg); OPL.FreeTempR(x.reg); x.reg := first; INCL(used, first)
  1631.         END;
  1632.         IF dtyp^.comp = DynArr THEN first := 3;
  1633.             WHILE first IN used DO INC(first) END;
  1634.             lreg := first; INCL(used, first)
  1635.         END;
  1636.         used := used * OPL.TempRegs;
  1637.         IF used = {} THEN first := 3
  1638.         ELSE first := 12;
  1639.             WHILE ~(first IN used) DO DEC(first) END;
  1640.             INC(first)
  1641.         END;
  1642.         noLenChk := FALSE; cnt := (12-first)*4;
  1643.         IF styp.comp = Array THEN
  1644.             IF dtyp.comp = Array THEN noLenChk := styp.n <= dtyp.n;
  1645.                 IF noLenChk THEN INC(cnt, 4) END;
  1646.                 restOnly := (styp.n <= cnt) OR (dtyp.n <= cnt);
  1647.                 noLoop := (styp.n <= 2*cnt) OR (dtyp.n <= 2*cnt)
  1648.             ELSE restOnly := styp.n <= cnt; noLoop := styp.n <= 2*cnt
  1649.             END
  1650.         ELSIF dtyp.comp = Array THEN restOnly := dtyp.n <= cnt; noLoop := dtyp.n <= 2*cnt
  1651.         END;
  1652.         end := 0; rest := 0;
  1653.         IF ~noLenChk OR restOnly THEN
  1654.             IF lreg = -1 THEN first := 3;
  1655.                 WHILE first IN used DO INC(first) END;
  1656.                 lreg := first;
  1657.                 IF ~noLenChk THEN INCL(used, lreg) END;
  1658.                 used := used * OPL.TempRegs;
  1659.                 IF used = {} THEN first := 3
  1660.                 ELSE first := 12;
  1661.                     WHILE ~(first IN used) DO DEC(first) END;
  1662.                     INC(first)
  1663.                 END
  1664.             END;
  1665.             ArrayLen(len, lreg); Load(len, lreg);
  1666.             IF ~restOnly THEN INCL(used, lreg);
  1667.                 IF (len.reg # lreg) THEN MoveReg(lreg, len.reg); OPL.FreeTempR(len.reg); len.reg := lreg END
  1668.             END
  1669.         END;
  1670.         ASSERT(first+(cnt DIV 4) <= 13);
  1671.         src := y.reg; dest := x.reg;
  1672.         end := 0; rest := 0;
  1673.         IF ~restOnly THEN
  1674.             OPL.Put(iLIL+first*fRT+cnt); OPL.Put(iMTXER+first*fRS);
  1675.             IF noLoop THEN OPL.Put(iLIL+0*fRT+0)
  1676.             ELSE
  1677.                 OPL.Put(iLIL+0*fRT+((-cnt) MOD LowWord));
  1678.                 loop := 0; SetLabel(loop);
  1679.                 OPL.Put(iADDIC+0*fRT+0*fRA+cnt)
  1680.             END;
  1681.             IF ~noLenChk THEN
  1682.                 OPL.Put(iADDICR+len.reg*fRT+len.reg*fRA+((-cnt) MOD LowWord));
  1683.                 PutBranchInstr(iBF+bGT*fBI, rest)
  1684.             END;
  1685.             OPL.Put(iLSCBX+first*fRT+src*fRA+0*fRB+fREC);
  1686.             OPL.Put(iSTSX+first*fRS+dest*fRA+0*fRB);
  1687.             IF noLoop THEN PutBranchInstr(iBT+bEQ*fBI, end); OPL.Put(iADDIC+0*fRT+0*fRA+cnt)
  1688.             ELSE PutBranchInstr(iBF+bEQ*fBI, loop);
  1689.                 IF ~noLenChk THEN PutBranchInstr(iBA, end) END
  1690.             END
  1691.         END;
  1692.         SetLabel(rest);
  1693.         IF ~noLenChk OR restOnly THEN
  1694.             IF ~noLenChk & ~restOnly THEN OPL.Put(iADDIC+len.reg*fRT+len.reg*fRA+cnt) END;
  1695.             OPL.Put(iMTXER+len.reg*fRS);
  1696.             IF restOnly THEN OPL.Put(iLIL+0*fRT+0) END;
  1697.             OPL.Put(iLSCBX+first*fRT+src*fRA+0*fRB+fREC);
  1698.             OPL.Put(iSTSX+first*fRS+dest*fRA+0*fRB);
  1699.             IF ~noLenChk THEN
  1700.                 PutBranchInstr(iBT+bEQ*fBI, end);
  1701.                 IF ~restOnly THEN OPL.Put(iLIL+0*fRT+0) END;
  1702.                 b.mode := Reg; b.reg := 0; b.typ := OPT.chartyp;
  1703.                 a.reg := dest; a.typ := OPT.chartyp;
  1704.                 IF dtyp^.comp = Array THEN a.mode := Based; a.offset := dtyp^.n-1
  1705.                 ELSE
  1706.                     OPL.Put(iADDI+len.reg*fRT+len.reg*fRA+((-1) MOD LowWord));
  1707.                     OPL.Put(iADD+len.reg*fRT+len.reg*fRA+0*fRB);
  1708.                     a.mode := Indexed; a.offset := len.reg
  1709.                 END;
  1710.                 Store(a, b)
  1711.             END
  1712.         END;
  1713.         SetLabel(end);
  1714.         OPL.FreeTempR(src); OPL.FreeTempR(dest); OPL.FreeTempR(len.reg)
  1715.     END POWERcopy;
  1716.     PROCEDURE Copy* (VAR x, y: OPL.Item);    (* copy y to x *)
  1717.         VAR len: OPL.Item;
  1718.     BEGIN
  1719.         IF (y.typ^.form = String) & (x.typ^.comp = Array) THEN
  1720.             len.mode := Con; len.offset := y.adr; len.typ := OPT.linttyp; Move(x, y, len, TRUE)
  1721.         ELSIF TRUE (*powerpc IN options*) THEN PPCcopy(x, y)
  1722.         ELSE POWERcopy(x, y)
  1723.         END
  1724.     END Copy;
  1725.     PROCEDURE With* (VAR x: OPL.Item);
  1726.     BEGIN
  1727.         IF x.mode IN {Reg, Based, Indexed} THEN OPL.FreeTempR(x.reg) END;
  1728.         IF x.mode = Indexed THEN OPL.FreeTempR(x.offset) END
  1729.     END With;
  1730.     PROCEDURE Msk* (VAR x, y: OPL.Item; rt: LONGINT);
  1731.         VAR s, mb: LONGINT;
  1732.     BEGIN y.offset := -1-y.offset;
  1733.         ASSERT((y.mode = Con) & (SYSTEM.VAL(SET, y.offset)*SYSTEM.VAL(SET, y.offset+1) = {}));
  1734.         Load(x, -1); mb := CNTLZ(y.offset); IF mb < 24 THEN MakeReg(x, -1) END;
  1735.         s := x.reg; OPL.FreeTempR(s); rt := CheckR(rt); OPL.Put(iRLINM+rt*fRA+s*fRS+mb*fMB+31*fME);
  1736.         x.mode := Reg; x.reg := rt
  1737.     END Msk;
  1738.     (* MskAsh and AshMsk, experimental 
  1739.     PROCEDURE Compare* (VAR x, y: OPL.Item; subcl: INTEGER);
  1740.         VAR f, tidx, s1, s2, t1, t2, b, bitNo: LONGINT; pol: BOOLEAN; tlab, lstlab, lastlab, endlab: OPL.Label; z: OPL.Item;
  1741.     BEGIN
  1742.         CASE x.typ^.form OF
  1743.             Real, LReal:
  1744.                 Load(x, -1); Load(y, -1); s1 := x.reg; s2 := y.reg; OPL.FreeTempF(s1); OPL.FreeTempF(s2);
  1745.                 f := OPL.GetTempCRF(); OPL.Put(iFCMPU+f*fBF+s1*fFRA+s2*fFRB)
  1746.         |  Byte, Char, SInt, Int, LInt, Set, Pointer, ProcTyp:
  1747.                 IF x.typ^.form = ProcTyp THEN x.typ := OPT.linttyp; y.typ := OPT.linttyp END;
  1748.                 IF x.mode = Con THEN subcl := switch[subcl-eql]; f := IntCmpImm(y, x)
  1749.                 ELSIF y.mode = Con THEN f := IntCmpImm(x, y)
  1750.                 ELSE f := IntCmp(x, y)
  1751.                 END
  1752.         |  Bool:
  1753.                 IF (x.mode = Cond) OR (y.mode = Cond) THEN
  1754.                     IF x.mode # Cond THEN Load(x, -1); RegToCond(x) END;
  1755.                     IF y.mode # Cond THEN Load(y, -1); RegToCond(y) END;
  1756.                     pol := subcl = eql; s1 := x.reg; s2 := y.reg;
  1757.                     IF s1 < 0 THEN s1 := -1-s1; pol := ~pol END;
  1758.                     IF s2 < 0 THEN s2 := -1-s2; pol := ~pol END;
  1759.                     OPL.FreeTempCRBs({s1, s2}); bitNo := OPL.GetTempCRB();
  1760.                     IF pol THEN f := iCREQV ELSE f := iCRXOR END;
  1761.                     OPL.Put(f+bitNo*fBT+s1*fBA+s2*fBB);
  1762.                     x.mode := Cond; x.reg := bitNo; RETURN
  1763.                 ELSE
  1764.                     f := IntCmp(x, y)
  1765.                 END
  1766.             |  String, Comp: (* 
  1767.                     LoadAddr (x, -1); LoadAddr (y, -1);
  1768.                     s1 := OPL.GetTempR (); s2 := OPL.GetTempR ();
  1769.                     OPL.Put (iCAL+s1*fRT+x.reg*fRA+65535);
  1770.                     OPL.Put (iCAL+s2*fRT+y.reg*fRA+65535);
  1771.                     
  1772.                     tidx := OPL.GetTempR (); t1 := OPL.GetTempR (); t2 := OPL.GetTempR ();
  1773.                     f := OPL.GetTempCRF (); 
  1774.                     lstlab := 0; lastlab := 0;
  1775.                     OPL.Put (iCAL+tidx*fRT+1);
  1776.                     SetLabel (lstlab);
  1777.                     OPL.Put (iLBZUX+t1*fRT+s1*fRA+tidx*fRB);
  1778.                     OPL.Put (iLBZUX+t2*fRT+s2*fRA+tidx*fRB);
  1779.                     OPL.Put (iCMP+f*fBF+t1*fRA+t2*fRB);
  1780.                     PutBranchInstr (iBF+(f*4+bEQ)*fBI, lastlab);
  1781.                     OPL.Put (iCMPI+f*fBF+t1*fRA+0);
  1782.                     PutBranchInstr (iBF+(f*4+bEQ)*fBI, lstlab);
  1783.                     OPL.Put (iCMP+f*fBF+t1*fRA+t2*fRB);
  1784.                     SetLabel (lastlab);
  1785.                     
  1786.                     OPL.FreeTempR (s1); OPL.FreeTempR (s2);
  1787.                     OPL.FreeTempR (x.reg); OPL.FreeTempR (y.reg);
  1788.                     OPL.FreeTempR (tidx); OPL.FreeTempR (t1); OPL.FreeTempR (t2)
  1789.         END;
  1790.         bitNo := CRbit[subcl-eql]; b := bitNo; IF b < 0 THEN b := -1-b END;
  1791.         INC(b, f*4); OPL.FreeTempCRBs({f*4..f*4+3}-{b}); IF bitNo < 0 THEN b := -1-b END;
  1792.         x.mode := Cond; x.reg := b
  1793.     END Compare;
  1794.     PROCEDURE Len* (VAR x, y: OPL.Item; rt: LONGINT);
  1795.     BEGIN
  1796.         ASSERT(x.mode = Based); OPL.FreeTempR(x.reg);
  1797.         IF x.dmode = Reg THEN
  1798.             x.mode := Reg; x.reg := x.dreg+y.offset+1
  1799.         ELSE
  1800.             x.mode := x.dmode; x.reg := x.dreg; x.offset := x.adr+y.offset*4+4
  1801.         END;
  1802.         IF x.dreg # -1 THEN OPL.UnholdTempR(x.dreg); OPL.FreeTempR(x.dreg); x.dreg := -1 END
  1803.     END Len;
  1804.     PROCEDURE SYSbit* (VAR x, y: OPL.Item);
  1805.         VAR z: OPL.Item;
  1806.     BEGIN
  1807.         Load(x, -1); MakeReg(x, -1); z := x; z.mode := Based; z.offset := 0; z.typ := OPT.settyp;
  1808.         x.mode := y.mode; x.reg := y.reg; x.offset := y.offset; x.typ := y.typ; x.dreg := y.dreg; In(x, z)
  1809.     END SYSbit;
  1810.     PROCEDURE Trap* (type: INTEGER);
  1811.     BEGIN OPL.SetTrap(type); OPL.Put(iT+tALWAYS*fTO)
  1812.     END Trap;
  1813.     PROCEDURE EnterLoop*;
  1814.     BEGIN DEC(LoopLevel); LoopStart[LoopLevel] := 0; LoopEnd[LoopLevel] := 0; SetLabel(LoopStart[LoopLevel])
  1815.     END EnterLoop;
  1816.     PROCEDURE ExitLoop*;
  1817.     BEGIN PutBranch(LoopEnd[LoopLevel])
  1818.     END ExitLoop;
  1819.     PROCEDURE EndLoop*;
  1820.     BEGIN PutBranch(LoopStart[LoopLevel]); SetLabel(LoopEnd[LoopLevel]); INC(LoopLevel)
  1821.     END EndLoop;
  1822.     PROCEDURE Case* (VAR x: OPL.Item; low, high: LONGINT; VAR table: LONGINT);
  1823.         VAR y: OPL.Item; c, t1, t2: LONGINT;
  1824.     BEGIN
  1825.         Load(x, -1); MakeReg(x, -1); x.typ := OPT.linttyp; y.dreg := -1;
  1826.         IF low # 0 THEN
  1827.             y.mode := Con; y.offset := low; y.typ := OPT.linttyp; Minus(x, y, -1); DEC(high, low)
  1828.         END;
  1829.         t1 := x.reg; ASSERT(high <= 32767);
  1830.         c := OPL.GetTempCRF(); OPL.Put(iCMPLI+c*fBF+t1*fRA+high); c := c*4; OPL.FreeTempCRBs({c..c+3}-{c+bGT});
  1831.         y.mode := Cond; y.reg := c+bGT; y.Tjmp := 0; y.Fjmp := 0; y.typ := OPT.booltyp; PutCondBranch(y, TRUE);
  1832.         OPL.FreeTempR(t1); t2 := OPL.GetTempR(); OPL.FreeTempR(t2); OPL.Put(iRLINM+t2*fRA+t1*fRS+2*fSH+29*fME);
  1833.         OPL.AllocCaseTable(high, table);
  1834.         t1 := OPL.GetTempR(); OPL.FreeTempR(t1); OPL.Put(iCAL+t1*fRT+SB*fRA+(table MOD 10000H));
  1835.         y.mode := Indexed; y.reg := t1; y.offset := t2; y.typ := OPT.linttyp; Load(y, -1);
  1836.         ASSERT(y.mode = Reg);
  1837.         t1 := y.reg; OPL.FreeTempR(t1); OPL.Put(iMTSPR+spCTR*fSPR+t1*fRS);
  1838.         OPL.SetCaseBranch(table); OPL.Put(iBCC+cALWAYS*fBO);
  1839.         SetLabel(y.Tjmp); OPL.FixCase(0, high, table)
  1840.     END Case;
  1841.     PROCEDURE Call* (VAR x: OPL.Item; outparsize: LONGINT);
  1842.         VAR sl, t, offset: LONGINT; y, z: OPL.Item;
  1843.     BEGIN
  1844.         y.dreg := -1; z.dreg := -1;
  1845.         IF outparsize > aopSize+32 THEN aopSize := outparsize-32 END;
  1846.         IF (x.mode = LProc) OR (x.mode = XProc) & (x.mnolev = 0) THEN
  1847.             IF x.mnolev > 0 THEN
  1848.                 sl := FindFP(OPL.level, x.mnolev, SLpar);
  1849.                 IF sl # SLpar THEN sl := CheckVFP(sl); OPL.Put(iCAL+SLpar*fRT+sl*fRA) END
  1850.             END;
  1851.             OPL.PutLCall(x)
  1852.         ELSIF x.mode = XProc THEN
  1853.             y.mode := Based; y.reg := SB; y.offset := -(x.mnolev*4)+OPL.linkTable; y.typ := OPT.linttyp;
  1854.             z.mode := Reg; z.reg := SB; z.typ := OPT.linttyp; Assign(z, y);
  1855.             OPL.PutXCall(x);
  1856.             OPL.Put(iL+SB*fRT+SP*fRA+20);
  1857.         ELSE (* x.mode IN {Var, VarPar, Based, Reg} *)
  1858.             IF x.mode # Reg THEN
  1859.                 Base(*OrInx*)(x, -1); ShortBase(x, -1); t := x.reg; offset := x.offset; OPL.FreeTempR(t);
  1860.                 OPL.Put(iL+t*fRA+(offset MOD LowWord));
  1861.                 OPL.Put(iMTSPR+spCTR*fSPR); OPL.Put(iL+SB*fRT+t*fRA+((offset+4) MOD LowWord))
  1862.             ELSE
  1863.                 t := x.reg; OPL.Put(iMTSPR+spCTR*fSPR+t*fRS); MoveReg(SB, t+1)
  1864.             END;
  1865.             OPL.Put(iBCC+cALWAYS*fBO+fLK); OPL.Put(iL+SB*fRT+SP*fRA+20)
  1866.         END
  1867.     END Call;
  1868.     PROCEDURE GetMethod* (VAR x: OPL.Item; typ: OPT.Struct; deref, super: BOOLEAN);
  1869.         VAR tag: OPL.Item;
  1870.     BEGIN
  1871.         IF super THEN
  1872.             IF typ^.form = Pointer THEN typ := typ^.BaseTyp END;
  1873.             typ := typ^.BaseTyp;
  1874.             tag.mode := Var; tag.mnolev := -typ^.mno; tag.offset := typ^.tdadr; tag.typ := OPT.linttyp; tag.dreg := -1;
  1875.             Load(tag, -1);
  1876.             x.mode := Based; x.reg := tag.reg; x.offset := -76-x.offset*8
  1877.         ELSE
  1878.             IF deref THEN
  1879.                 tag.mode := Based; tag.reg := 3; tag.offset := -4; tag.typ := OPT.linttyp; tag.dreg := -1;
  1880.                 Load(tag, -1);
  1881.                 x.mode := Based; x.reg := tag.reg; x.offset := -76-x.offset*8
  1882.             ELSE
  1883.                 x.mode := Based; x.reg := 4; x.offset := -76-x.offset*8
  1884.             END
  1885.         END
  1886.     END GetMethod;
  1887.     PROCEDURE SaveRegisters* (VAR x: OPL.Item; VAR saved: OPL.SaveDesc);
  1888.     BEGIN OPL.SaveRegisters(x, saved, sSize)
  1889.     END SaveRegisters;
  1890.     PROCEDURE RestoreRegisters* (VAR res: OPL.Item; VAR saved: OPL.SaveDesc; rt: LONGINT);
  1891.     BEGIN OPL.RestoreRegisters(res, saved, rt)
  1892.     END RestoreRegisters;
  1893.     PROCEDURE DynArrCopy (p: OPT.Object; leaf, saveCR: BOOLEAN);
  1894.         VAR t0, t1, t2, t3, t4, ralloc, rt: LONGINT; x, y, z, h, hd: OPL.Item; typ: OPT.Struct; loop: OPL.Label;
  1895.     BEGIN
  1896.         (* get source into y, dest into x *)
  1897.         typ := p^.typ; ralloc := p^.adr; y.typ := OPT.linttyp; y.dreg := -1;
  1898.         IF ralloc < 0 THEN ralloc := -1-ralloc; y.mode := SHORT(SHORT(ralloc DIV 32)); y.reg := ralloc MOD 32
  1899.         ELSE y.mode := Based; y.reg := FP; y.offset := (*ralloc*) p^.linkadr
  1900.         END;
  1901.         y.dmode := y.mode; y.dreg := SHORT(SHORT(y.reg)); y.adr := y.offset;
  1902.         ralloc := p^.linkadr; x.typ := OPT.linttyp;
  1903.         IF ralloc < 0 THEN ralloc := -1-ralloc; x.mode := SHORT(SHORT(ralloc DIV 32)); rt := ralloc MOD 32; x.reg := rt
  1904.         ELSE x.mode := Based; x.reg := FP; x.offset := ralloc; rt := -1
  1905.         END;
  1906.         x.dmode := x.mode; x.dreg := SHORT(SHORT(x.reg)); x.adr := x.offset;
  1907.         (* move len part of descriptor *)
  1908.         hd := x; h.typ := OPT.linttyp; h.dreg := -1;
  1909.         IF y.dmode = Reg THEN
  1910.             t0 := typ^.n; h.mode := Reg; h.reg := y.dreg+1;
  1911.             WHILE t0 >= 0 DO
  1912.                 IF hd.mode = Reg THEN INC(hd.reg) ELSE INC(hd.offset, 4) END;
  1913.                 Assign(hd, h); INC(h.reg); DEC(t0)
  1914.             END
  1915.         END;
  1916.         (* compute type size into z *)
  1917.         Load(y, -1); y.mode := Based; y.offset := 0; y.dmode := x.dmode; y.dreg := x.dreg; y.adr := x.adr; z := y;
  1918.         TypeSize(z, typ, -1); Load(z, -1); MakeReg(z, -1); t0 := z.reg;
  1919.         (* align to 8 and allocate the space *)
  1920.         t1 := OPL.GetTempR(); OPL.Put(iL+t1*fRT+SP*fRA); (* t1 = dynamic link *)
  1921.         t2 := OPL.GetTempR(); OPL.Put(iAI+t2*fRT+t0*fRA+7);
  1922.         OPL.FreeTempR(t0); t0 := OPL.GetTempR(); OPL.Put(iRLINM+t2*fRS+t0*fRA+28*fME); OPL.FreeTempR(t2);
  1923.         (*z.reg := t0; *)OPL.Put(iSF+SP*fRT+t0*fRA+SP*fRB); OPL.Put(iST+t1*fRS+SP*fRA); OPL.FreeTempR(t1);
  1924.         IF ~leaf THEN
  1925.             OPL.Put(iST+SB*fRS+SP*fRA+20); (*OPL.Put(iST+t4*fRS+SP*fRA+8); OPL.FreeTempR(t4)*)
  1926.         END;
  1927.         (* this is the assignment of the new pointer *)
  1928.         rt := CheckR(rt); OPL.Put(iCAL+rt*fRT+SP*fRA+(FPlink MOD LowWord)); FPlink := SHORT(1-OPL.pc);
  1929.         h.mode := Reg; h.reg := rt; h.typ := OPT.linttyp; Assign(x, h);
  1930.         (* this is the actual move step *)
  1931.         OPL.FreeTempR(t0); t1 := OPL.GetTempR(); OPL.Put(iRLINM+t0*fRS+t1*fRA+29*fSH+3*fMB+31*fME);
  1932.         OPL.Put(iMTSPR+t1*fRS+spCTR*fSPR); OPL.FreeTempR(t1);
  1933.         DEC(y.offset, 4); LoadAddr(y, -1); t1 := y.reg;
  1934.         t0 := OPL.GetTempR(); OPL.Put(iCAL+t0*fRT+SP*fRA+(FPlink4 MOD LowWord)); FPlink4 := SHORT(1-OPL.pc);
  1935.         (*t2 := OPL.GetTempRegs(2, {}); t3 := t2+1;*) t2 := OPL.GetTempR(); t3 := OPL.GetTempR();
  1936.         loop := 0; SetLabel(loop);
  1937.         OPL.Put(iLU+t2*fRT+t1*fRA+4); OPL.Put(iLU+t3*fRT+t1*fRA+4);
  1938.         OPL.Put(iSTU+t2*fRS+t0*fRA+4); OPL.Put(iSTU+t3*fRS+t0*fRA+4);
  1939.         PutBranchInstr(iBCNTNZ, loop);
  1940.         (*OPL.FreeTempRegs(t2, 2); *) OPL.FreeTempR(t2); OPL.FreeTempR(t3); OPL.FreeTempR(t0); OPL.FreeTempR(t1)
  1941.     END DynArrCopy;
  1942.     PROCEDURE InitPtrs* (proc: OPT.Object);
  1943.         CONST MaxPtrs = 16;
  1944.         VAR
  1945.             reg, ptr: LONGINT; nofptrs: INTEGER;
  1946.             ptrTab: ARRAY MaxPtrs+1 OF LONGINT;
  1947.             obj, lastobj: OPT.Object;
  1948.             size, x: OPL.Item;
  1949.             loop: OPL.Label;
  1950.     BEGIN
  1951.         reg := -1; obj := proc^.scope^.scope;    (* local variables *)
  1952.         WHILE obj # NIL DO    (* find pointer registers *)
  1953.             IF (obj^.linkadr < -1) & (obj^.typ^.form = Pointer) THEN
  1954.                 reg := (-1-obj^.linkadr) MOD 32; OPL.Put(iCAL+reg*fRT)
  1955.             END;
  1956.             obj := obj^.link
  1957.         END;
  1958.         nofptrs := 0; obj := proc^.scope^.scope;
  1959.         WHILE (obj # NIL) & (nofptrs <= MaxPtrs) DO    (* find pointers in memory *)
  1960.             IF obj^.linkadr >= 0 THEN OPL.FindPtrs(obj^.typ, obj^.linkadr, ptrTab, nofptrs); lastobj := obj END;
  1961.             obj := obj^.link
  1962.         END;
  1963.         IF nofptrs > MaxPtrs THEN    (* initialize from the first pointer to the end of the frame *)
  1964.             obj := lastobj;
  1965.             WHILE obj # NIL DO
  1966.                 IF obj^.linkadr >= 0 THEN lastobj := obj END;
  1967.                 obj := obj^.link
  1968.             END;
  1969.             size.mode := Con; size.typ := OPT.linttyp; size.offset := (lastobj^.linkadr + lastobj^.typ^.size - ptrTab[0]) DIV 4;
  1970.             Load(size, -1); OPL.Put(iMTSPR+spCTR*fSPR+size.reg*fRS); OPL.FreeTempR(size.reg);
  1971.             IF reg < 0 THEN reg := 0; OPL.Put(iCAL) END;
  1972.             IF ptrTab[0] = 4 THEN    (* address to be loaded would become 0(FP), therefore copy *)
  1973.                 ptr := OPL.GetTempR(); OPL.Put(iCAL+ptr*fRT+FP*fRA)
  1974.             ELSE
  1975.                 x.mode := Based; x.reg := FP; x.offset := ptrTab[0]-4; x.typ := OPT.linttyp;
  1976.                 LoadAddr(x, -1); ptr := x.reg
  1977.             END;
  1978.             SetLabel(loop); OPL.Put(iSTU+reg*fRS+ptr*fRA+4); PutBranchInstr(iBCNTNZ, loop);
  1979.             OPL.FreeTempR(ptr)
  1980.         ELSIF nofptrs > 0 THEN
  1981.             IF reg < 0 THEN reg := 0; OPL.Put(iCAL) END;
  1982.             size.typ := OPT.linttyp; size.mode := Reg; size.reg := reg;
  1983.             x.typ := OPT.linttyp; x.mode := Based;
  1984.             WHILE nofptrs > 0 DO DEC(nofptrs);
  1985.                 x.reg := FP; x.offset := ptrTab[nofptrs]; Store(x, size)
  1986.             END
  1987.         END
  1988.     END InitPtrs;
  1989.     PROCEDURE Enter* (n: OPT.Object);
  1990.         VAR l: OPL.Label; x, y: OPL.Item; ralloc, falloc, calloc, fsize: LONGINT; parR, parF: SET;
  1991.             p: OPT.Object; typ: OPT.Struct; form, comp, nrReg: LONGINT; rdest, leaf: BOOLEAN;
  1992.     BEGIN
  1993.         x.dreg := -1; y.dreg := -1;
  1994.         IF n # NIL THEN
  1995.             IF n^.mode = LProc THEN
  1996.                 l := SHORT(n^.adr); IF l = -1 THEN l := 0 END;
  1997.                 SetLabel(l); n^.adr := l
  1998.             ELSE
  1999.                 ralloc := n^.adr MOD LowWord;
  2000.                 IF OPL.entry[ralloc] = -1 THEN OPL.entry[ralloc] := 0 END;
  2001.                 SetLabel(OPL.entry[ralloc]) 
  2002.             END;
  2003.             FP := 31;
  2004.             fsize := n^.conval^.intval2; calloc := n^.conval^.intval; ralloc := (calloc DIV 1024) MOD 32;
  2005.             falloc := (calloc DIV 32) MOD 32; calloc := calloc MOD 32;
  2006.             parR := n^.conval^.setval; parF := SYSTEM.ROT(parR, -16)*{1..13}; parR := SYSTEM.LSH(parR, -1)*{3..10};
  2007.             leaf := n^.leaf & (falloc = 31); n^.leaf := leaf;
  2008.             IF n^.mnolev > 0 THEN INCL(parR, SLpar) END
  2009.         ELSE
  2010.             ralloc := 30; falloc := 31; calloc := 19; fsize := 8; parR := {}; parF := {}; FP := 31; leaf := FALSE;
  2011.             IF OPL.entry[0] = -1 THEN OPL.entry[0] := 0 END;
  2012.             SetLabel(OPL.entry[0])
  2013.         END;
  2014.         OPL.LockTempR(parR); OPL.LockTempF(parF);
  2015.         OPL.GenProcEntry(fsize, ralloc, falloc, calloc, FP, leaf, (n # NIL) & (n^.mnolev > 0));
  2016.         IF n # NIL THEN p := n^.link;
  2017.             WHILE p # NIL DO
  2018.                 IF p^.adr < 0 THEN
  2019.                     typ := p^.typ; form := typ^.form;
  2020.                     IF (p^.mode # Var) OR (form # Comp) THEN
  2021.                         IF p^.mode = VarPar THEN
  2022.                             IF form = Comp THEN comp := typ^.comp;
  2023.                                 IF comp = DynArr THEN nrReg := typ^.n+2
  2024.                                 ELSIF comp = Record THEN nrReg := 2
  2025.                                 ELSE nrReg := 1
  2026.                                 END
  2027.                             ELSE nrReg := 1
  2028.                             END;
  2029.                             typ := OPT.linttyp
  2030.                         ELSE
  2031.                             nrReg := 1
  2032.                         END;
  2033.                         ralloc := -1-p^.adr; y.mode := SHORT(SHORT(ralloc DIV 32)); y.reg := ralloc MOD 32;
  2034.                         (*y.typ := OPT.linttyp;*) y.typ := typ;
  2035.                         y.Tjmp := 0; y.Fjmp := 0; ralloc := p^.linkadr; rdest := ralloc < 0;
  2036.                         IF rdest THEN ralloc := -1-ralloc; x.mode := SHORT(SHORT(ralloc DIV 32)); x.reg := ralloc MOD 32
  2037.                         ELSE x.mode := Based; x.reg := FP; x.offset := ralloc
  2038.                         END;
  2039.                         (*x.typ := OPT.linttyp;*) x.typ := typ;
  2040.                         REPEAT
  2041.                             Assign(x, y); INC(y.reg); DEC(nrReg);
  2042.                             IF rdest THEN INC(x.reg, 1) ELSE INC(x.offset, 4) END
  2043.                         UNTIL nrReg = 0
  2044.                     END
  2045.                 END;
  2046.                 p := p^.link
  2047.             END
  2048.         END;
  2049.         aopSize := 0; sSize := 0; SLsize := 0; SBoffset := fsize+20;
  2050.         IF (n # NIL) & (n^.mnolev > 0) THEN
  2051.             y.mode := Reg; y.reg := SLpar; y.typ := OPT.linttyp;
  2052.             x.mode := Based; x.reg := FP; x.offset := -4; x.typ := OPT.linttyp;
  2053.             Assign(x, y); SLsize := 8
  2054.         END;
  2055.         IF n # NIL THEN p := n^.link; FPlink := 0; FPlink4 := 0;
  2056.             WHILE p # NIL DO
  2057.                 typ := p^.typ; form := typ^.form;
  2058.                 IF (p^.mode = Var) & (form = Comp) THEN
  2059.                     comp := typ^.comp;
  2060.                     IF comp = DynArr THEN DynArrCopy(p, leaf, calloc < 19)
  2061.                     ELSE
  2062.                         ralloc := p^.adr; y.typ := OPT.linttyp;
  2063.                         IF ralloc < 0 THEN y.reg := (-1-ralloc) MOD 32
  2064.                         ELSE y.mode := Based; y.reg := FP; y.offset := ralloc+fsize; Load(y, -1)
  2065.                         END;
  2066.                         y.mode := Based; y.typ := p^.typ; y.offset := 0;
  2067.                         x.mode := Based; x.reg := FP; x.offset := p^.linkadr; x.typ := p^.typ;
  2068.                         Assign(x, y)
  2069.                     END
  2070.                 END;
  2071.                 p := p^.link
  2072.             END
  2073.         END;
  2074.         IF (n # NIL) & (ptrinit IN options) THEN InitPtrs(n) END;
  2075.         leaveProc := 0;
  2076.     END Enter;
  2077.     PROCEDURE Leave* (VAR n: OPT.Object);
  2078.         VAR regs, fsize, psize: LONGINT;
  2079.     BEGIN
  2080.         INC(sSize, sSize MOD 8); psize := aopSize+sSize+SLsize+8*4+6*4; INC(psize, psize MOD 8);
  2081.         IF n # NIL THEN
  2082.             OPL.FixupFP(FPlink, FPlink4, psize-(sSize+SLsize));
  2083.             IF n^.typ^.form # NoTyp THEN
  2084.                 IF n^.typ^.form IN {Real, LReal} THEN OPL.LockParF(1)
  2085.                 ELSE
  2086.                     IF n^.typ^.form = ProcTyp THEN OPL.LockParR(4) END;
  2087.                     OPL.LockParR(3)
  2088.                 END;
  2089.                 OPL.SetTrap(FuncTrap); OPL.Put(iT+cALWAYS*fTO)
  2090.             END;
  2091.             SetLabel(leaveProc);
  2092.             regs := n^.conval^.intval; fsize := n^.conval^.intval2;
  2093.             OPL.GenProcExit(fsize, psize, (regs  DIV 1024) MOD 32, (regs DIV 32) MOD 32, regs MOD 32, FP, n^.leaf);
  2094.             OPL.FreePar;
  2095.             OPL.OutRefPoint(fsize, psize, (regs DIV 1024) MOD 32, (regs DIV 32) MOD 32, regs MOD 32, n^.leaf)
  2096.         ELSE
  2097.             SetLabel(leaveProc);
  2098.             OPL.GenProcExit(8, psize, 30, 31, 19, FP, FALSE);
  2099.             OPL.OutRefPoint(8, psize, 30, 31, 19, FALSE)
  2100.         END
  2101.     END Leave;
  2102.     PROCEDURE Return* (VAR x: OPL.Item);
  2103.     BEGIN
  2104.         IF x.mode = FReg THEN OPL.FreeTempF(x.reg)
  2105.         ELSIF x.mode = Reg THEN OPL.FreeTempR(x.reg);
  2106.             IF x.typ^.form = ProcTyp THEN OPL.FreeTempR(x.reg+1) END
  2107.         END;
  2108.         PutBranch(leaveProc)
  2109.     END Return;
  2110.     PROCEDURE Assign* (VAR x, y: OPL.Item);
  2111.         VAR rt, t: LONGINT; z: OPL.Item;
  2112.     BEGIN
  2113.         IF y.typ^.form = Comp THEN
  2114.             z.mode := Con; z.typ := OPT.linttyp; z.offset := x.typ^.size; Move(x, y, z, FALSE)
  2115.         ELSIF x.typ^.form = ProcTyp THEN
  2116.             IF y.mode = XProc THEN
  2117.                 rt := -1; IF x.mode = Reg THEN rt := x.reg END;
  2118.                 z := y; OPL.LoadProcAddr(z, rt); x.typ := OPT.linttyp; Assign(x, z);
  2119.                 IF y.mnolev = 0 THEN y.mode := Reg ELSE y.mode := Based; y.offset := -(y.mnolev*4)+OPL.linkTable END;
  2120.                 y.reg := SB; y.typ := OPT.linttyp;
  2121.                 IF x.mode = Reg THEN INC(x.reg) ELSE INC(x.offset, 4) END;
  2122.                 Assign(x, y)
  2123.             ELSIF y.mode = Con THEN ASSERT(y.typ^.form = NilTyp);
  2124.                 IF x.mode # Reg THEN Base(x, -1) END;
  2125.                 x.typ := OPT.linttyp; z := zero; Assign(x, z);
  2126.                 IF x.mode = Reg THEN INC(x.reg) ELSE INC(x.offset, 4) END;
  2127.                 Assign(x, z)
  2128.             ELSE
  2129.                 IF x.mode # Reg THEN Base(x, -1) END;
  2130.                 IF y.mode # Reg THEN Base(y, -1) END;
  2131.                 x.typ := OPT.linttyp; y.typ := OPT.linttyp;
  2132.                 z := y; Assign(x, y);
  2133.                 IF x.mode = Reg THEN INC(x.reg) ELSE INC(x.offset, 4) END;
  2134.                 IF z.mode = Reg THEN INC(z.reg) ELSE INC(z.offset, 4) END;
  2135.                 Assign(x, z)
  2136.             END
  2137.         ELSIF y.typ^.form = String THEN
  2138.             Copy(x, y)
  2139.         ELSIF (y.typ^.form = Bool) & (y.mode = Con) & (x.mode = Cond) THEN
  2140.             rt := x.reg; ASSERT((0 <= rt) & (rt <= 31));
  2141.             IF y.offset = 0 THEN OPL.Put(iCRXOR+rt*fBT) ELSE OPL.Put(iCREQV+rt*fBT) END
  2142.         ELSE t := -1; rt := -1;
  2143.             IF x.mode = Reg THEN
  2144.                 rt := x.reg; IF (y.typ^.form # SInt) OR (y.mode = Con) THEN t := rt END
  2145.             ELSIF x.mode = FReg THEN
  2146.                 rt := x.reg; IF y.typ^.form IN {Real, LReal} THEN t := x.reg END
  2147.             END;
  2148.             Load(y, t); Convert(y, x.typ, rt, x.mode = FReg); Store(x, y)
  2149.         END
  2150.     END Assign;
  2151.     PROCEDURE Increment* (VAR x, y: OPL.Item; inc: BOOLEAN);
  2152.         VAR z: OPL.Item;
  2153.     BEGIN
  2154.         IF x.mode = Reg THEN 
  2155.             IF inc THEN Plus(x, y, x.reg) ELSE Minus(x, y, x.reg) END
  2156.         ELSE BaseOrInx(x, -1);
  2157.             IF x.mode = Based THEN ShortBase(x, -1) END;
  2158.             z := x; IF inc THEN Plus(x, y, -1) ELSE Minus(x, y, -1) END;
  2159.             Store(z, x)
  2160.         END
  2161.     END Increment;
  2162.     PROCEDURE Include* (VAR x, y: OPL.Item);
  2163.         VAR z: OPL.Item;
  2164.     BEGIN
  2165.         IF y.mode = Con THEN
  2166.             IF OPM.CeresVersion THEN y.offset := SYSTEM.VAL(LONGINT, {31-y.offset})
  2167.             ELSE y.offset := SYSTEM.VAL(LONGINT, {y.offset})
  2168.             END;
  2169.             y.typ := OPT.settyp
  2170.         ELSE SetElem(y, -1)
  2171.         END;
  2172.         IF x.mode = Reg THEN Plus(x, y, x.reg)
  2173.         ELSE BaseOrInx(x, -1);
  2174.             IF x.mode = Based THEN ShortBase(x, -1) END;
  2175.             z := x; Plus(x, y, -1); Store(z, x)
  2176.         END
  2177.     END Include;
  2178.     PROCEDURE Exclude* (VAR x, y: OPL.Item);
  2179.         VAR ycon: BOOLEAN; bit, s, t: LONGINT; z: OPL.Item;
  2180.     BEGIN
  2181.         ycon := y.mode = Con;
  2182.         IF ycon THEN bit := y.offset ELSE SetElem(y, -1) END;
  2183.         IF x.mode = Reg THEN
  2184.             IF ycon THEN OPL.Put(iRLINM+x.reg*fRA+x.reg*fRS+((bit+1) MOD 32)*fMB+((bit-1) MOD 32)*fME)
  2185.             ELSE Minus(x, y, x.reg)
  2186.             END
  2187.         ELSE BaseOrInx(x, -1);
  2188.             IF x.mode = Based THEN ShortBase(x, -1) END;
  2189.             z := x;
  2190.             IF ycon THEN Load(x, -1); s := x.reg; OPL.FreeTempR(s); t := OPL.GetTempR(); OPL.FreeTempR(t);
  2191.                 OPL.Put(iRLINM+t*fRA+s*fRS+((bit+1) MOD 32)*fMB+((bit-1) MOD 32)*fME); x.reg := t
  2192.             ELSE Minus(x, y, -1)
  2193.             END;
  2194.             Store(z, x)
  2195.         END
  2196.     END Exclude;
  2197.     PROCEDURE Init* (opt: SET);
  2198.     BEGIN
  2199.         options := opt; IntToRealAddr := 0; LoopLevel := OPM.MaxExit;
  2200.         CaseLink := -1; NewRecEntry := -1; NewSysEntry := -1; NewArrEntry := -1;
  2201.         scratch := -1; RealToIntAddr := 0
  2202.     END Init;
  2203. BEGIN
  2204.     BLI[Undef] := -1; BLI[Byte] := iLBZ; BLI[Bool] := iLBZ; BLI[Char] := iLBZ; BLI[SInt] := iLBZ; BLI[Int] := iLHA;
  2205.     BLI[LInt] := iL; BLI[Real] := iLFS; BLI[LReal] := iLFD; BLI[Set] := iL; BLI[String] := -1; BLI[NilTyp] := iL;
  2206.     BLI[NoTyp] := -1; BLI[Pointer] := iL; XLI[Undef] := -1; XLI[Byte] := iLBZX; XLI[Bool] := iLBZX; XLI[Char] := iLBZX;
  2207.     XLI[SInt] := iLBZX; XLI[Int] := iLHAX; XLI[LInt] := iLX; XLI[Real] := iLFSX; XLI[LReal] := iLFDX; XLI[Set] := iLX;
  2208.     XLI[String] := -1; XLI[NilTyp] := iLX; XLI[NoTyp] := -1; XLI[Pointer] := iLX;
  2209.     BSI[Undef] := -1; BSI[Byte] := iSTB; BSI[Bool] := iSTB; BSI[Char] := iSTB; BSI[SInt] := iSTB; BSI[Int] := iSTH;
  2210.     BSI[LInt] := iST; BSI[Real] := iSTFS; BSI[LReal] := iSTFD; BSI[Set] := iST; BSI[String] := -1; BSI[NilTyp] := iST;
  2211.     BSI[NoTyp] := -1; BSI[Pointer] := iST; XSI[Undef] := -1; XSI[Byte] := iSTBX; XSI[Bool] := iSTBX; XSI[Char] := iSTBX;
  2212.     XSI[SInt] := iSTBX; XSI[Int] := iSTHX; XSI[LInt] := iSTX; XSI[Real] := iSTFSX; XSI[LReal] := iSTFDX; XSI[Set] := iSTX;
  2213.     XSI[String] := -1; XSI[NilTyp] := iSTX; XSI[NoTyp] := -1; XSI[Pointer] := iSTX;
  2214.     IntToRealBlock[0] := 43X; IntToRealBlock[1] := 30X; IntToRealBlock[2] := 0X; IntToRealBlock[3] := 0X;
  2215.     IntToRealBlock[4] := 80X; IntToRealBlock[5] := 0X; IntToRealBlock[6] := 0X; IntToRealBlock[7] := 0X;
  2216.     IntToRealBlock[8] := 43X; IntToRealBlock[9] := 30X; IntToRealBlock[10] := 0X; IntToRealBlock[11] := 0X;
  2217.     IntToRealBlock[12] := 0X; IntToRealBlock[13] := 0X; IntToRealBlock[14] := 0X; IntToRealBlock[15] := 0X;
  2218.     RealToIntBlock[0] := 43X; RealToIntBlock[1] := 30X; RealToIntBlock[2] := 0X; RealToIntBlock[3] := 1X;
  2219.     RealToIntBlock[4] := 0X; RealToIntBlock[5] := 0X; RealToIntBlock[6] := 0X; RealToIntBlock[7] := 0X;
  2220.     zero.mode := Con; zero.offset := 0; zero.typ := OPT.linttyp; zero.dreg := -1;
  2221.     CAPmask.mode := Con; CAPmask.offset := 5FH; CAPmask.typ := OPT.settyp; CAPmask.dreg := -1;
  2222.     CRbit[eql-eql] := bEQ; CRbit[neq-eql] := -1-bEQ; CRbit[lss-eql] := bLT; CRbit[leq-eql] := -1-bGT;
  2223.     CRbit[gtr-eql] := bGT; CRbit[geq-eql] := -1-bLT;
  2224.     switch[eql-eql] := eql; switch[neq-eql] := neq; switch[lss-eql] := gtr; switch[leq-eql] := geq;
  2225.     switch[gtr-eql] := lss; switch[geq-eql] := leq
  2226. END POPC.
  2227.